86 integer,
intent(in) :: ng, model
90 logical,
dimension((Ngrids-1)*2) :: lcoincident
91 logical,
dimension((Ngrids-1)*2) :: lcomposite
92 logical,
dimension((Ngrids-1)*2) :: lmosaic
93 logical,
dimension((Ngrids-1)*2) :: lrefinement
95 logical,
dimension((Ngrids-1)*2) :: linterpolate
97 integer :: cr, dg, ibry, ic, ig, ip, m, rg, vindex
98 integer :: my_ncontact, my_ngrids, my_nlweights, my_nqweights
101 integer,
dimension(Ngrids) :: my_lm, my_mm
102 integer,
dimension(Ngrids) :: refine_factor
104 integer,
dimension((Ngrids-1)*2) :: npointsr
105 integer,
dimension((Ngrids-1)*2) :: npointsu
106 integer,
dimension((Ngrids-1)*2) :: npointsv
108 real(r8),
allocatable :: lweight(:,:)
109# ifdef QUADRATIC_WEIGHTS
110 real(r8),
allocatable :: qweight(:,:)
112 real(r8),
allocatable :: xrg(:), yrg(:)
113 real(r8),
allocatable :: angle(:)
114 real(r8),
allocatable :: dmde(:), dndx(:)
115 real(r8),
allocatable :: f(:)
116 real(r8),
allocatable :: h(:)
117 real(r8),
allocatable :: mask(:)
118 real(r8),
allocatable :: pm(:), pn(:)
120 character (len=*),
parameter :: myfile = &
121 & __FILE__//
", set_contact_nf90"
133 20
FORMAT (/,
' SET_CONTACT_NF90 - unable to open contact points ', &
134 &
' NetCDF file: ',a)
148 & dimname =
'Ngrids', &
149 & dimsize = my_ngrids)
152 IF (my_ngrids.ne.
ngrids)
THEN
154 WRITE (
stdout,10)
'inconsistent parameter, Ngrids = ', &
156 10
FORMAT (/,
' SET_CONTACT_NF90 - ', a, i4, 2x, i4, &
157 & /,20x,
'in input file:'2x,a)
167 & dimname =
'Ncontact', &
168 & dimsize = my_ncontact)
171 IF (my_ncontact.ne.(
ngrids-1)*2)
THEN
173 WRITE (
stdout,10)
'inconsistent parameter, Ncontact = ', &
174 & (
ngrids-1)*2, my_ncontact
185 & dimname =
'nLweights', &
186 & dimsize = my_nlweights)
189 IF (my_nlweights.ne.4)
THEN
191 WRITE (
stdout,10)
'inconsistent parameter, nLweights = ', &
198# ifdef QUADRATIC_WEIGHTS
204 & dimname =
'nQweights', &
205 & dimsize = my_nqweights)
208 IF (my_nqweights.ne.9)
THEN
210 WRITE (
stdout,10)
'inconsistent parameter, nQweights = ', &
223 & dimname =
'datum', &
241 IF (my_lm(ig).ne.
lm(ig))
THEN
243 WRITE (
stdout,10)
'inconsistent grid order, Lm = ', &
249 IF (my_mm(ig).ne.
mm(ig))
THEN
251 WRITE (
stdout,10)
'inconsistent grid order, Mm = ', &
262 &
'coincident', lcoincident, &
267 &
'composite', lcomposite, &
272 &
'mosaic', lmosaic, &
277 &
'refinement', lrefinement, &
284 &
'refine_factor', refine_factor, &
291 &
'interpolate', linterpolate, &
318 IF (.not.
allocated(
i_left))
THEN
327 IF (.not.
allocated(
i_right))
THEN
345 IF (.not.
allocated(
j_top))
THEN
357 IF (.not.
allocated(
nstrr))
THEN
366 IF (.not.
allocated(
nendr))
THEN
375 IF (.not.
allocated(
nstru))
THEN
384 IF (.not.
allocated(
nendu))
THEN
393 IF (.not.
allocated(
nstrv))
THEN
402 IF (.not.
allocated(
nendv))
THEN
438 IF (.not.
allocated(
idg_cp))
THEN
447 IF (.not.
allocated(
jdg_cp))
THEN
458 IF (.not.
allocated(
irg_cp))
THEN
467 IF (.not.
allocated(
jrg_cp))
THEN
478 IF (.not.
allocated(xrg))
THEN
487 IF (.not.
allocated(yrg))
THEN
499 IF (.not.
allocated(lweight))
THEN
500 allocate ( lweight(my_nlweights,
ncdatum) )
504 &
'Lweight', lweight, &
508# ifdef QUADRATIC_WEIGHTS
513 IF (.not.
allocated(qweight))
THEN
514 allocate ( qweight(my_nqweights,
ncdatum) )
518 &
'Qweight', qweight, &
525 IF (.not.
allocated(h))
THEN
536 IF (.not.
allocated(f))
THEN
548 IF (.not.
allocated(pm))
THEN
557 IF (.not.
allocated(pn))
THEN
569 IF (.not.
allocated(dndx))
THEN
578 IF (.not.
allocated(dmde))
THEN
589 IF (.not.
allocated(angle))
THEN
600 IF (.not.
allocated(mask))
THEN
628 ncpoints(cr)=npointsr(cr)+npointsu(cr)+npointsv(cr)
644 allocate (
rcontact(cr) % Irg(npointsr(cr)) )
645 allocate (
ucontact(cr) % Irg(npointsu(cr)) )
646 allocate (
vcontact(cr) % Irg(npointsv(cr)) )
648 allocate (
rcontact(cr) % Jrg(npointsr(cr)) )
649 allocate (
ucontact(cr) % Jrg(npointsu(cr)) )
650 allocate (
vcontact(cr) % Jrg(npointsv(cr)) )
652 allocate (
rcontact(cr) % Idg(npointsr(cr)) )
653 allocate (
ucontact(cr) % Idg(npointsu(cr)) )
654 allocate (
vcontact(cr) % Idg(npointsv(cr)) )
656 allocate (
rcontact(cr) % Jdg(npointsr(cr)) )
657 allocate (
ucontact(cr) % Jdg(npointsu(cr)) )
658 allocate (
vcontact(cr) % Jdg(npointsv(cr)) )
660 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsr(cr),r8)
661 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsu(cr),r8)
662 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsv(cr),r8)
665 allocate (
rcontact(cr) % Kdg(
n(dg),npointsr(cr)) )
666 allocate (
ucontact(cr) % Kdg(
n(dg),npointsu(cr)) )
667 allocate (
vcontact(cr) % Kdg(
n(dg),npointsv(cr)) )
669 dmem(dg)=
dmem(dg)+real(
n(dg)*npointsr(cr),r8)
670 dmem(dg)=
dmem(dg)+real(
n(dg)*npointsu(cr),r8)
671 dmem(dg)=
dmem(dg)+real(
n(dg)*npointsv(cr),r8)
674 allocate (
rcontact(cr) % Lweight(4,npointsr(cr)) )
675 allocate (
ucontact(cr) % Lweight(4,npointsu(cr)) )
676 allocate (
vcontact(cr) % Lweight(4,npointsv(cr)) )
678 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsr(cr),r8)
679 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsu(cr),r8)
680 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsv(cr),r8)
683 allocate (
rcontact(cr) % LweightUnmasked(4,npointsr(cr)) )
684 allocate (
ucontact(cr) % LweightUnmasked(4,npointsu(cr)) )
685 allocate (
vcontact(cr) % LweightUnmasked(4,npointsv(cr)) )
687 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsr(cr),r8)
688 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsu(cr),r8)
689 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsv(cr),r8)
692# ifdef QUADRATIC_WEIGHTS
693 allocate (
rcontact(cr) % Qweight(9,npointsr(cr)) )
694 allocate (
ucontact(cr) % Qweight(9,npointsu(cr)) )
695 allocate (
vcontact(cr) % Qweight(9,npointsv(cr)) )
697 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsr(cr),r8)
698 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsu(cr),r8)
699 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsv(cr),r8)
702 allocate (
rcontact(cr) % QweightUnmasked(9,npointsr(cr)) )
703 allocate (
ucontact(cr) % QweightUnmasked(9,npointsu(cr)) )
704 allocate (
vcontact(cr) % QweightUnmasked(9,npointsv(cr)) )
706 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsr(cr),r8)
707 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsu(cr),r8)
708 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsv(cr),r8)
713 allocate (
rcontact(cr) % Vweight(2,
n(dg),npointsr(cr)) )
714 allocate (
ucontact(cr) % Vweight(2,
n(dg),npointsu(cr)) )
715 allocate (
vcontact(cr) % Vweight(2,
n(dg),npointsv(cr)) )
717 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsr(cr),r8)
718 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsu(cr),r8)
719 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsv(cr),r8)
721# if defined TANGENT || defined TL_IOMS
722 allocate (
rcontact(cr) % tl_Vweight(2,
n(dg),npointsr(cr)) )
723 allocate (
ucontact(cr) % tl_Vweight(2,
n(dg),npointsu(cr)) )
724 allocate (
vcontact(cr) % tl_Vweight(2,
n(dg),npointsv(cr)) )
726 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsr(cr),r8)
727 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsu(cr),r8)
728 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsv(cr),r8)
732 allocate (
rcontact(cr) % ad_Vweight(2,
n(dg),npointsr(cr)) )
733 allocate (
ucontact(cr) % ad_Vweight(2,
n(dg),npointsu(cr)) )
734 allocate (
vcontact(cr) % ad_Vweight(2,
n(dg),npointsv(cr)) )
736 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsr(cr),r8)
737 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsu(cr),r8)
738 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsv(cr),r8)
749 rcontact(cr) % coincident = lcoincident(rg)
750 ucontact(cr) % coincident = lcoincident(rg)
751 vcontact(cr) % coincident = lcoincident(rg)
753 rcontact(cr) % interpolate = linterpolate(rg)
754 ucontact(cr) % interpolate = linterpolate(rg)
755 vcontact(cr) % interpolate = linterpolate(rg)
765 rcontact(cr) % Npoints = npointsr(cr)
766 ucontact(cr) % Npoints = npointsu(cr)
767 vcontact(cr) % Npoints = npointsv(cr)
776 rcontact(cr) % LweightUnmasked(1,m) = lweight(1,ip)
777 rcontact(cr) % LweightUnmasked(2,m) = lweight(2,ip)
778 rcontact(cr) % LweightUnmasked(3,m) = lweight(3,ip)
779 rcontact(cr) % LweightUnmasked(4,m) = lweight(4,ip)
781 rcontact(cr) % Lweight(1,m) = lweight(1,ip)
782 rcontact(cr) % Lweight(2,m) = lweight(2,ip)
783 rcontact(cr) % Lweight(3,m) = lweight(3,ip)
784 rcontact(cr) % Lweight(4,m) = lweight(4,ip)
785# ifdef QUADRATIC_WEIGHTS
787 rcontact(cr) % QweightUnmasked(1,m) = qweight(1,ip)
788 rcontact(cr) % QweightUnmasked(2,m) = qweight(2,ip)
789 rcontact(cr) % QweightUnmasked(3,m) = qweight(3,ip)
790 rcontact(cr) % QweightUnmasked(4,m) = qweight(4,ip)
791 rcontact(cr) % QweightUnmasked(5,m) = qweight(5,ip)
792 rcontact(cr) % QweightUnmasked(6,m) = qweight(6,ip)
793 rcontact(cr) % QweightUnmasked(7,m) = qweight(7,ip)
794 rcontact(cr) % QweightUnmasked(8,m) = qweight(8,ip)
795 rcontact(cr) % QweightUnmasked(9,m) = qweight(9,ip)
797 rcontact(cr) % Qweight(1,m) = qweight(1,ip)
798 rcontact(cr) % Qweight(2,m) = qweight(2,ip)
799 rcontact(cr) % Qweight(3,m) = qweight(3,ip)
800 rcontact(cr) % Qweight(4,m) = qweight(4,ip)
801 rcontact(cr) % Qweight(5,m) = qweight(5,ip)
802 rcontact(cr) % Qweight(6,m) = qweight(6,ip)
803 rcontact(cr) % Qweight(7,m) = qweight(7,ip)
804 rcontact(cr) % Qweight(8,m) = qweight(8,ip)
805 rcontact(cr) % Qweight(9,m) = qweight(9,ip)
816 ucontact(cr) % LweightUnmasked(1,m) = lweight(1,ip)
817 ucontact(cr) % LweightUnmasked(2,m) = lweight(2,ip)
818 ucontact(cr) % LweightUnmasked(3,m) = lweight(3,ip)
819 ucontact(cr) % LweightUnmasked(4,m) = lweight(4,ip)
821 ucontact(cr) % Lweight(1,m) = lweight(1,ip)
822 ucontact(cr) % Lweight(2,m) = lweight(2,ip)
823 ucontact(cr) % Lweight(3,m) = lweight(3,ip)
824 ucontact(cr) % Lweight(4,m) = lweight(4,ip)
825# ifdef QUADRATIC_WEIGHTS
827 ucontact(cr) % QweightUnmasked(1,m) = qweight(1,ip)
828 ucontact(cr) % QweightUnmasked(2,m) = qweight(2,ip)
829 ucontact(cr) % QweightUnmasked(3,m) = qweight(3,ip)
830 ucontact(cr) % QweightUnmasked(4,m) = qweight(4,ip)
831 ucontact(cr) % QweightUnmasked(5,m) = qweight(5,ip)
832 ucontact(cr) % QweightUnmasked(6,m) = qweight(6,ip)
833 ucontact(cr) % QweightUnmasked(7,m) = qweight(7,ip)
834 ucontact(cr) % QweightUnmasked(8,m) = qweight(8,ip)
835 ucontact(cr) % QweightUnmasked(9,m) = qweight(9,ip)
837 ucontact(cr) % Qweight(1,m) = qweight(1,ip)
838 ucontact(cr) % Qweight(2,m) = qweight(2,ip)
839 ucontact(cr) % Qweight(3,m) = qweight(3,ip)
840 ucontact(cr) % Qweight(4,m) = qweight(4,ip)
841 ucontact(cr) % Qweight(5,m) = qweight(5,ip)
842 ucontact(cr) % Qweight(6,m) = qweight(6,ip)
843 ucontact(cr) % Qweight(7,m) = qweight(7,ip)
844 ucontact(cr) % Qweight(8,m) = qweight(8,ip)
845 ucontact(cr) % Qweight(9,m) = qweight(9,ip)
856 vcontact(cr) % LweightUnmasked(1,m) = lweight(1,ip)
857 vcontact(cr) % LweightUnmasked(2,m) = lweight(2,ip)
858 vcontact(cr) % LweightUnmasked(3,m) = lweight(3,ip)
859 vcontact(cr) % LweightUnmasked(4,m) = lweight(4,ip)
861 vcontact(cr) % Lweight(1,m) = lweight(1,ip)
862 vcontact(cr) % Lweight(2,m) = lweight(2,ip)
863 vcontact(cr) % Lweight(3,m) = lweight(3,ip)
864 vcontact(cr) % Lweight(4,m) = lweight(4,ip)
865# ifdef QUADRATIC_WEIGHTS
867 vcontact(cr) % QweightUnmasked(1,m) = qweight(1,ip)
868 vcontact(cr) % QweightUnmasked(2,m) = qweight(2,ip)
869 vcontact(cr) % QweightUnmasked(3,m) = qweight(3,ip)
870 vcontact(cr) % QweightUnmasked(4,m) = qweight(4,ip)
871 vcontact(cr) % QweightUnmasked(5,m) = qweight(5,ip)
872 vcontact(cr) % QweightUnmasked(6,m) = qweight(6,ip)
873 vcontact(cr) % QweightUnmasked(7,m) = qweight(7,ip)
874 vcontact(cr) % QweightUnmasked(8,m) = qweight(8,ip)
875 vcontact(cr) % QweightUnmasked(9,m) = qweight(9,ip)
877 vcontact(cr) % Qweight(1,m) = qweight(1,ip)
878 vcontact(cr) % Qweight(2,m) = qweight(2,ip)
879 vcontact(cr) % Qweight(3,m) = qweight(3,ip)
880 vcontact(cr) % Qweight(4,m) = qweight(4,ip)
881 vcontact(cr) % Qweight(5,m) = qweight(5,ip)
882 vcontact(cr) % Qweight(6,m) = qweight(6,ip)
883 vcontact(cr) % Qweight(7,m) = qweight(7,ip)
884 vcontact(cr) % Qweight(8,m) = qweight(8,ip)
885 vcontact(cr) % Qweight(9,m) = qweight(9,ip)
919 dmem(ng)=
dmem(ng)+10.0_r8*real(npointsr(cr),r8)
920 dmem(ng)=
dmem(ng)+ 3.0_r8*real(npointsu(cr),r8)
921 dmem(ng)=
dmem(ng)+ 3.0_r8*real(npointsv(cr),r8)
975 IF ((ibry.eq.
iwest ).or.(ibry.eq.
ieast ).or. &
998 IF (any(lcoincident).or.any(lcomposite))
THEN
1125 allocate (
composite(cr) % bustr(4,npointsu(cr)) )
1126 allocate (
composite(cr) % bvstr(4,npointsv(cr)) )
1128 allocate (
composite(cr) % ubar(4,npointsu(cr),2) )
1129 allocate (
composite(cr) % vbar(4,npointsv(cr),2) )
1130 allocate (
composite(cr) % zeta(4,npointsr(cr),2) )
1132 allocate (
composite(cr) % rzeta(4,npointsr(cr)) )
1134 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsr(cr),r8)
1135 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsu(cr),r8)
1136 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsv(cr),r8)
1138# if defined TANGENT || defined TL_IOMS
1139 allocate (
composite(cr) % tl_bustr(4,npointsu(cr)) )
1140 allocate (
composite(cr) % tl_bvstr(4,npointsv(cr)) )
1142 allocate (
composite(cr) % tl_ubar(4,npointsu(cr),2) )
1143 allocate (
composite(cr) % tl_vbar(4,npointsv(cr),2) )
1144 allocate (
composite(cr) % tl_zeta(4,npointsr(cr),2) )
1146 allocate (
composite(cr) % tl_rzeta(4,npointsr(cr)) )
1148 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsr(cr),r8)
1149 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsu(cr),r8)
1150 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsv(cr),r8)
1154 allocate (
composite(cr) % ad_bustr(4,npointsu(cr)) )
1155 allocate (
composite(cr) % ad_bvstr(4,npointsv(cr)) )
1157 allocate (
composite(cr) % ad_ubar(4,npointsu(cr),2) )
1158 allocate (
composite(cr) % ad_vbar(4,npointsv(cr),2) )
1159 allocate (
composite(cr) % ad_zeta(4,npointsr(cr),2) )
1161 allocate (
composite(cr) % ad_rzeta(4,npointsr(cr)) )
1163 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsr(cr),r8)
1164 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsu(cr),r8)
1165 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsv(cr),r8)
1169 allocate (
composite(cr) % DU_avg1(4,npointsu(cr)) )
1170 allocate (
composite(cr) % DV_avg1(4,npointsv(cr)) )
1171 allocate (
composite(cr) % Zt_avg1(4,npointsr(cr)) )
1173 dmem(dg)=
dmem(dg)+real(4*npointsr(cr),r8)
1174 dmem(dg)=
dmem(dg)+real(4*npointsu(cr),r8)
1175 dmem(dg)=
dmem(dg)+real(4*npointsv(cr),r8)
1177 allocate (
composite(cr) % u(4,
n(dg),npointsu(cr)) )
1178 allocate (
composite(cr) % v(4,
n(dg),npointsv(cr)) )
1180 allocate (
composite(cr) % Huon(4,
n(dg),npointsu(cr)) )
1181 allocate (
composite(cr) % Hvom(4,
n(dg),npointsv(cr)) )
1183 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr),r8)
1184 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsv(cr),r8)
1186 allocate (
composite(cr) % t(4,
n(dg),npointsr(cr),
nt(dg)) )
1188 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr)*
nt(dg),r8)
1190# if defined TANGENT || defined TL_IOMS
1191 allocate (
composite(cr) % tl_DU_avg1(4,npointsu(cr)) )
1192 allocate (
composite(cr) % tl_DV_avg1(4,npointsv(cr)) )
1193 allocate (
composite(cr) % tl_Zt_avg1(4,npointsr(cr)) )
1195 dmem(dg)=
dmem(dg)+real(4*npointsr(cr),r8)
1196 dmem(dg)=
dmem(dg)+real(4*npointsu(cr),r8)
1197 dmem(dg)=
dmem(dg)+real(4*npointsv(cr),r8)
1199 allocate (
composite(cr) % tl_u(4,
n(dg),npointsu(cr)) )
1200 allocate (
composite(cr) % tl_v(4,
n(dg),npointsv(cr)) )
1202 allocate (
composite(cr) % tl_Huon(4,
n(dg),npointsu(cr)) )
1203 allocate (
composite(cr) % tl_Hvom(4,
n(dg),npointsv(cr)) )
1205 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr),r8)
1206 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsv(cr),r8)
1208 allocate (
composite(cr) % tl_t(4,
n(dg),npointsr(cr),
nt(dg)) )
1210 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr)*
nt(dg),r8)
1214 allocate (
composite(cr) % ad_DU_avg1(4,npointsu(cr)) )
1215 allocate (
composite(cr) % ad_DV_avg1(4,npointsv(cr)) )
1216 allocate (
composite(cr) % ad_Zt_avg1(4,npointsr(cr)) )
1218 dmem(dg)=
dmem(dg)+real(4*npointsr(cr),r8)
1219 dmem(dg)=
dmem(dg)+real(4*npointsu(cr),r8)
1220 dmem(dg)=
dmem(dg)+real(4*npointsv(cr),r8)
1222 allocate (
composite(cr) % ad_u(4,
n(dg),npointsu(cr)) )
1223 allocate (
composite(cr) % ad_v(4,
n(dg),npointsv(cr)) )
1225 allocate (
composite(cr) % ad_Huon(4,
n(dg),npointsu(cr)) )
1226 allocate (
composite(cr) % ad_Hvom(4,
n(dg),npointsv(cr)) )
1228 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr),r8)
1229 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsv(cr),r8)
1231 allocate (
composite(cr) % ad_t(4,
n(dg),npointsr(cr),
nt(dg)) )
1233 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr)*
nt(dg),r8)
1254 allocate (
refined(cr) % ubar(4,npointsu(cr),2) )
1255 allocate (
refined(cr) % vbar(4,npointsv(cr),2) )
1256 allocate (
refined(cr) % zeta(4,npointsr(cr),2) )
1258 allocate (
refined(cr) % U2d_flux(4,npointsu(cr),2) )
1259 allocate (
refined(cr) % V2d_flux(4,npointsv(cr),2) )
1261 allocate (
refined(cr) % on_u(npointsu(cr)) )
1262 allocate (
refined(cr) % om_v(npointsv(cr)) )
1264 dmem(rg)=
dmem(rg)+real(4*npointsr(cr),r8)
1265 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsu(cr),r8)
1266 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsv(cr),r8)
1268# if defined TANGENT || defined TL_IOMS
1269 allocate (
refined(cr) % tl_ubar(4,npointsu(cr),2) )
1270 allocate (
refined(cr) % tl_vbar(4,npointsv(cr),2) )
1271 allocate (
refined(cr) % tl_zeta(4,npointsr(cr),2) )
1273 allocate (
refined(cr) % tl_U2d_flux(4,npointsu(cr),2) )
1274 allocate (
refined(cr) % tl_V2d_flux(4,npointsv(cr),2) )
1276 dmem(rg)=
dmem(rg)+real(4*npointsr(cr),r8)
1277 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsu(cr),r8)
1278 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsv(cr),r8)
1282 allocate (
refined(cr) % ad_ubar(4,npointsu(cr),2) )
1283 allocate (
refined(cr) % ad_vbar(4,npointsv(cr),2) )
1284 allocate (
refined(cr) % ad_zeta(4,npointsr(cr),2) )
1286 allocate (
refined(cr) % ad_U2d_flux(4,npointsu(cr),2) )
1287 allocate (
refined(cr) % ad_V2d_flux(4,npointsv(cr),2) )
1289 dmem(rg)=
dmem(rg)+real(4*npointsr(cr),r8)
1290 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsu(cr),r8)
1291 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsv(cr),r8)
1296 allocate (
refined(cr) % u(4,
n(rg),npointsu(cr),2) )
1297 allocate (
refined(cr) % v(4,
n(rg),npointsv(cr),2) )
1299 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsu(cr),r8)
1300 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsv(cr),r8)
1302 allocate (
refined(cr) % t(4,
n(rg),npointsr(cr),2,
nt(rg)) )
1304 dmem(rg)=
dmem(rg)+2.0_r8*real(4*
n(rg)*npointsr(cr)*
nt(rg),r8)
1306# if defined TANGENT || defined TL_IOMS
1307 allocate (
refined(cr) % tl_u(4,
n(rg),npointsu(cr),2) )
1308 allocate (
refined(cr) % tl_v(4,
n(rg),npointsv(cr),2) )
1310 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsu(cr),r8)
1311 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsv(cr),r8)
1313 allocate (
refined(cr) % tl_t(4,
n(rg),npointsr(cr),2,
nt(rg)) )
1315 dmem(rg)=
dmem(rg)+2.0_r8*real(4*
n(rg)*npointsr(cr)*
nt(rg),r8)
1319 allocate (
refined(cr) % ad_u(4,
n(rg),npointsu(cr),2) )
1320 allocate (
refined(cr) % ad_v(4,
n(rg),npointsv(cr),2) )
1322 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsu(cr),r8)
1323 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsv(cr),r8)
1325 allocate (
refined(cr) % ad_t(4,
n(rg),npointsr(cr),2,
nt(rg)) )
1327 dmem(rg)=
dmem(rg)+2.0_r8*real(4*
n(rg)*npointsr(cr)*
nt(rg),r8)
1344 integer,
intent(in) :: ng, model
1348 logical,
dimension((Ngrids-1)*2) :: lcoincident
1349 logical,
dimension((Ngrids-1)*2) :: lcomposite
1350 logical,
dimension((Ngrids-1)*2) :: lmosaic
1351 logical,
dimension((Ngrids-1)*2) :: lrefinement
1353 logical,
dimension((Ngrids-1)*2) :: linterpolate
1355 integer :: cr, dg, ibry, ic, ig, ip, m, rg, vindex
1356 integer :: my_ncontact, my_ngrids, my_nlweights, my_nqweights
1358 integer,
dimension(Ngrids) :: my_lm, my_mm
1359 integer,
dimension(Ngrids) :: refine_factor
1361 integer,
dimension((Ngrids-1)*2) :: npointsr
1362 integer,
dimension((Ngrids-1)*2) :: npointsu
1363 integer,
dimension((Ngrids-1)*2) :: npointsv
1365 real(r8),
allocatable :: lweight(:,:)
1366# ifdef QUADRATIC_WEIGHTS
1367 real(r8),
allocatable :: qweight(:,:)
1369 real(r8),
allocatable :: xrg(:), yrg(:)
1370 real(r8),
allocatable :: angle(:)
1371 real(r8),
allocatable :: dmde(:), dndx(:)
1372 real(r8),
allocatable :: f(:)
1373 real(r8),
allocatable :: h(:)
1374 real(r8),
allocatable :: mask(:)
1375 real(r8),
allocatable :: pm(:), pn(:)
1377 character (len=*),
parameter :: myfile = &
1378 & __FILE__//
", set_contact_pio"
1380 TYPE (file_desc_t) :: ngcpiofile
1394 20
FORMAT (/,
' SET_CONTACT_PIO - unable to open contact points ', &
1395 &
' NetCDF file: ',a)
1402 & piofile = ngcpiofile)
1408 & piofile = ngcpiofile, &
1409 & dimname =
'Ngrids', &
1410 & dimsize = my_ngrids)
1413 IF (my_ngrids.ne.
ngrids)
THEN
1415 WRITE (
stdout,10)
'inconsistent parameter, Ngrids = ', &
1417 10
FORMAT (/,
' SET_CONTACT_PIO - ', a, i4, 2x, i4, &
1418 & /,19x,
'in input file:'2x,a)
1427 & piofile = ngcpiofile, &
1428 & dimname =
'Ncontact', &
1429 & dimsize = my_ncontact)
1432 IF (my_ncontact.ne.(
ngrids-1)*2)
THEN
1434 WRITE (
stdout,10)
'inconsistent parameter, Ncontact = ', &
1435 & (
ngrids-1)*2, my_ncontact
1445 & piofile = ngcpiofile, &
1446 & dimname =
'nLweights', &
1447 & dimsize = my_nlweights)
1450 IF (my_nlweights.ne.4)
THEN
1452 WRITE (
stdout,10)
'inconsistent parameter, nLweights = ', &
1459# ifdef QUADRATIC_WEIGHTS
1464 & piofile = ngcpiofile, &
1465 & dimname =
'nQweights', &
1466 & dimsize = my_nqweights)
1469 IF (my_nqweights.ne.9)
THEN
1471 WRITE (
stdout,10)
'inconsistent parameter, nQweights = ', &
1483 & piofile = ngcpiofile, &
1484 & dimname =
'datum', &
1493 & piofile = ngcpiofile)
1498 & piofile = ngcpiofile)
1502 IF (my_lm(ig).ne.
lm(ig))
THEN
1504 WRITE (
stdout,10)
'inconsistent grid order, Lm = ', &
1510 IF (my_mm(ig).ne.
mm(ig))
THEN
1512 WRITE (
stdout,10)
'inconsistent grid order, Mm = ', &
1523 &
'coincident', lcoincident, &
1524 & piofile = ngcpiofile)
1528 &
'composite', lcomposite, &
1529 & piofile = ngcpiofile)
1533 &
'mosaic', lmosaic, &
1534 & piofile = ngcpiofile)
1538 &
'refinement', lrefinement, &
1539 & piofile = ngcpiofile)
1545 &
'refine_factor', refine_factor, &
1546 & piofile = ngcpiofile)
1552 &
'interpolate', linterpolate, &
1553 & piofile = ngcpiofile)
1564 & piofile = ngcpiofile)
1573 & piofile = ngcpiofile)
1579 IF (.not.
allocated(
i_left))
THEN
1585 & piofile = ngcpiofile)
1588 IF (.not.
allocated(
i_right))
THEN
1594 & piofile = ngcpiofile)
1603 & piofile = ngcpiofile)
1606 IF (.not.
allocated(
j_top))
THEN
1612 & piofile = ngcpiofile)
1618 IF (.not.
allocated(
nstrr))
THEN
1624 & piofile = ngcpiofile)
1627 IF (.not.
allocated(
nendr))
THEN
1633 & piofile = ngcpiofile)
1636 IF (.not.
allocated(
nstru))
THEN
1642 & piofile = ngcpiofile)
1645 IF (.not.
allocated(
nendu))
THEN
1651 & piofile = ngcpiofile)
1654 IF (.not.
allocated(
nstrv))
THEN
1660 & piofile = ngcpiofile)
1663 IF (.not.
allocated(
nendv))
THEN
1669 & piofile = ngcpiofile)
1680 & piofile = ngcpiofile)
1693 & piofile = ngcpiofile)
1699 IF (.not.
allocated(
idg_cp))
THEN
1705 & piofile = ngcpiofile)
1708 IF (.not.
allocated(
jdg_cp))
THEN
1714 & piofile = ngcpiofile)
1719 IF (.not.
allocated(
irg_cp))
THEN
1725 & piofile = ngcpiofile)
1728 IF (.not.
allocated(
jrg_cp))
THEN
1734 & piofile = ngcpiofile)
1739 IF (.not.
allocated(xrg))
THEN
1745 & piofile = ngcpiofile)
1748 IF (.not.
allocated(yrg))
THEN
1754 & piofile = ngcpiofile)
1760 IF (.not.
allocated(lweight))
THEN
1761 allocate ( lweight(my_nlweights,
ncdatum) )
1765 &
'Lweight', lweight, &
1766 & piofile = ngcpiofile)
1769# ifdef QUADRATIC_WEIGHTS
1774 IF (.not.
allocated(qweight))
THEN
1775 allocate ( qweight(my_nqweights,
ncdatum) )
1779 &
'Qweight', qweight, &
1780 & piofile = ngcpiofile)
1786 IF (.not.
allocated(h))
THEN
1792 & piofile = ngcpiofile)
1797 IF (.not.
allocated(f))
THEN
1803 & piofile = ngcpiofile)
1809 IF (.not.
allocated(pm))
THEN
1815 & piofile = ngcpiofile)
1818 IF (.not.
allocated(pn))
THEN
1824 & piofile = ngcpiofile)
1830 IF (.not.
allocated(dndx))
THEN
1836 & piofile = ngcpiofile)
1839 IF (.not.
allocated(dmde))
THEN
1845 & piofile = ngcpiofile)
1850 IF (.not.
allocated(angle))
THEN
1856 & piofile = ngcpiofile)
1861 IF (.not.
allocated(mask))
THEN
1867 & piofile = ngcpiofile)
1889 ncpoints(cr)=npointsr(cr)+npointsu(cr)+npointsv(cr)
1905 allocate (
rcontact(cr) % Irg(npointsr(cr)) )
1906 allocate (
ucontact(cr) % Irg(npointsu(cr)) )
1907 allocate (
vcontact(cr) % Irg(npointsv(cr)) )
1909 allocate (
rcontact(cr) % Jrg(npointsr(cr)) )
1910 allocate (
ucontact(cr) % Jrg(npointsu(cr)) )
1911 allocate (
vcontact(cr) % Jrg(npointsv(cr)) )
1913 allocate (
rcontact(cr) % Idg(npointsr(cr)) )
1914 allocate (
ucontact(cr) % Idg(npointsu(cr)) )
1915 allocate (
vcontact(cr) % Idg(npointsv(cr)) )
1917 allocate (
rcontact(cr) % Jdg(npointsr(cr)) )
1918 allocate (
ucontact(cr) % Jdg(npointsu(cr)) )
1919 allocate (
vcontact(cr) % Jdg(npointsv(cr)) )
1921 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsr(cr),r8)
1922 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsu(cr),r8)
1923 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsv(cr),r8)
1926 allocate (
rcontact(cr) % Kdg(
n(dg),npointsr(cr)) )
1927 allocate (
ucontact(cr) % Kdg(
n(dg),npointsu(cr)) )
1928 allocate (
vcontact(cr) % Kdg(
n(dg),npointsv(cr)) )
1930 dmem(dg)=
dmem(dg)+real(
n(dg)*npointsr(cr),r8)
1931 dmem(dg)=
dmem(dg)+real(
n(dg)*npointsu(cr),r8)
1932 dmem(dg)=
dmem(dg)+real(
n(dg)*npointsv(cr),r8)
1935 allocate (
rcontact(cr) % Lweight(4,npointsr(cr)) )
1936 allocate (
ucontact(cr) % Lweight(4,npointsu(cr)) )
1937 allocate (
vcontact(cr) % Lweight(4,npointsv(cr)) )
1939 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsr(cr),r8)
1940 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsu(cr),r8)
1941 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsv(cr),r8)
1944 allocate (
rcontact(cr) % LweightUnmasked(4,npointsr(cr)) )
1945 allocate (
ucontact(cr) % LweightUnmasked(4,npointsu(cr)) )
1946 allocate (
vcontact(cr) % LweightUnmasked(4,npointsv(cr)) )
1948 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsr(cr),r8)
1949 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsu(cr),r8)
1950 dmem(dg)=
dmem(dg)+4.0_r8*real(npointsv(cr),r8)
1953# ifdef QUADRATIC_WEIGHTS
1954 allocate (
rcontact(cr) % Qweight(9,npointsr(cr)) )
1955 allocate (
ucontact(cr) % Qweight(9,npointsu(cr)) )
1956 allocate (
vcontact(cr) % Qweight(9,npointsv(cr)) )
1958 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsr(cr),r8)
1959 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsu(cr),r8)
1960 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsv(cr),r8)
1963 allocate (
rcontact(cr) % QweightUnmasked(9,npointsr(cr)) )
1964 allocate (
ucontact(cr) % QweightUnmasked(9,npointsu(cr)) )
1965 allocate (
vcontact(cr) % QweightUnmasked(9,npointsv(cr)) )
1967 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsr(cr),r8)
1968 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsu(cr),r8)
1969 dmem(dg)=
dmem(dg)+9.0_r8*real(npointsv(cr),r8)
1974 allocate (
rcontact(cr) % Vweight(2,
n(dg),npointsr(cr)) )
1975 allocate (
ucontact(cr) % Vweight(2,
n(dg),npointsu(cr)) )
1976 allocate (
vcontact(cr) % Vweight(2,
n(dg),npointsv(cr)) )
1978 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsr(cr),r8)
1979 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsu(cr),r8)
1980 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsv(cr),r8)
1982# if defined TANGENT || defined TL_IOMS
1983 allocate (
rcontact(cr) % tl_Vweight(2,
n(dg),npointsr(cr)) )
1984 allocate (
ucontact(cr) % tl_Vweight(2,
n(dg),npointsu(cr)) )
1985 allocate (
vcontact(cr) % tl_Vweight(2,
n(dg),npointsv(cr)) )
1987 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsr(cr),r8)
1988 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsu(cr),r8)
1989 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsv(cr),r8)
1993 allocate (
rcontact(cr) % ad_Vweight(2,
n(dg),npointsr(cr)) )
1994 allocate (
ucontact(cr) % ad_Vweight(2,
n(dg),npointsu(cr)) )
1995 allocate (
vcontact(cr) % ad_Vweight(2,
n(dg),npointsv(cr)) )
1997 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsr(cr),r8)
1998 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsu(cr),r8)
1999 dmem(dg)=
dmem(dg)+2.0_r8*real(
n(dg)*npointsv(cr),r8)
2010 rcontact(cr) % coincident = lcoincident(rg)
2011 ucontact(cr) % coincident = lcoincident(rg)
2012 vcontact(cr) % coincident = lcoincident(rg)
2014 rcontact(cr) % interpolate = linterpolate(rg)
2015 ucontact(cr) % interpolate = linterpolate(rg)
2016 vcontact(cr) % interpolate = linterpolate(rg)
2026 rcontact(cr) % Npoints = npointsr(cr)
2027 ucontact(cr) % Npoints = npointsu(cr)
2028 vcontact(cr) % Npoints = npointsv(cr)
2037 rcontact(cr) % LweightUnmasked(1,m) = lweight(1,ip)
2038 rcontact(cr) % LweightUnmasked(2,m) = lweight(2,ip)
2039 rcontact(cr) % LweightUnmasked(3,m) = lweight(3,ip)
2040 rcontact(cr) % LweightUnmasked(4,m) = lweight(4,ip)
2042 rcontact(cr) % Lweight(1,m) = lweight(1,ip)
2043 rcontact(cr) % Lweight(2,m) = lweight(2,ip)
2044 rcontact(cr) % Lweight(3,m) = lweight(3,ip)
2045 rcontact(cr) % Lweight(4,m) = lweight(4,ip)
2046# ifdef QUADRATIC_WEIGHTS
2048 rcontact(cr) % QweightUnmasked(1,m) = qweight(1,ip)
2049 rcontact(cr) % QweightUnmasked(2,m) = qweight(2,ip)
2050 rcontact(cr) % QweightUnmasked(3,m) = qweight(3,ip)
2051 rcontact(cr) % QweightUnmasked(4,m) = qweight(4,ip)
2052 rcontact(cr) % QweightUnmasked(5,m) = qweight(5,ip)
2053 rcontact(cr) % QweightUnmasked(6,m) = qweight(6,ip)
2054 rcontact(cr) % QweightUnmasked(7,m) = qweight(7,ip)
2055 rcontact(cr) % QweightUnmasked(8,m) = qweight(8,ip)
2056 rcontact(cr) % QweightUnmasked(9,m) = qweight(9,ip)
2058 rcontact(cr) % Qweight(1,m) = qweight(1,ip)
2059 rcontact(cr) % Qweight(2,m) = qweight(2,ip)
2060 rcontact(cr) % Qweight(3,m) = qweight(3,ip)
2061 rcontact(cr) % Qweight(4,m) = qweight(4,ip)
2062 rcontact(cr) % Qweight(5,m) = qweight(5,ip)
2063 rcontact(cr) % Qweight(6,m) = qweight(6,ip)
2064 rcontact(cr) % Qweight(7,m) = qweight(7,ip)
2065 rcontact(cr) % Qweight(8,m) = qweight(8,ip)
2066 rcontact(cr) % Qweight(9,m) = qweight(9,ip)
2077 ucontact(cr) % LweightUnmasked(1,m) = lweight(1,ip)
2078 ucontact(cr) % LweightUnmasked(2,m) = lweight(2,ip)
2079 ucontact(cr) % LweightUnmasked(3,m) = lweight(3,ip)
2080 ucontact(cr) % LweightUnmasked(4,m) = lweight(4,ip)
2082 ucontact(cr) % Lweight(1,m) = lweight(1,ip)
2083 ucontact(cr) % Lweight(2,m) = lweight(2,ip)
2084 ucontact(cr) % Lweight(3,m) = lweight(3,ip)
2085 ucontact(cr) % Lweight(4,m) = lweight(4,ip)
2086# ifdef QUADRATIC_WEIGHTS
2088 ucontact(cr) % QweightUnmasked(1,m) = qweight(1,ip)
2089 ucontact(cr) % QweightUnmasked(2,m) = qweight(2,ip)
2090 ucontact(cr) % QweightUnmasked(3,m) = qweight(3,ip)
2091 ucontact(cr) % QweightUnmasked(4,m) = qweight(4,ip)
2092 ucontact(cr) % QweightUnmasked(5,m) = qweight(5,ip)
2093 ucontact(cr) % QweightUnmasked(6,m) = qweight(6,ip)
2094 ucontact(cr) % QweightUnmasked(7,m) = qweight(7,ip)
2095 ucontact(cr) % QweightUnmasked(8,m) = qweight(8,ip)
2096 ucontact(cr) % QweightUnmasked(9,m) = qweight(9,ip)
2098 ucontact(cr) % Qweight(1,m) = qweight(1,ip)
2099 ucontact(cr) % Qweight(2,m) = qweight(2,ip)
2100 ucontact(cr) % Qweight(3,m) = qweight(3,ip)
2101 ucontact(cr) % Qweight(4,m) = qweight(4,ip)
2102 ucontact(cr) % Qweight(5,m) = qweight(5,ip)
2103 ucontact(cr) % Qweight(6,m) = qweight(6,ip)
2104 ucontact(cr) % Qweight(7,m) = qweight(7,ip)
2105 ucontact(cr) % Qweight(8,m) = qweight(8,ip)
2106 ucontact(cr) % Qweight(9,m) = qweight(9,ip)
2117 vcontact(cr) % LweightUnmasked(1,m) = lweight(1,ip)
2118 vcontact(cr) % LweightUnmasked(2,m) = lweight(2,ip)
2119 vcontact(cr) % LweightUnmasked(3,m) = lweight(3,ip)
2120 vcontact(cr) % LweightUnmasked(4,m) = lweight(4,ip)
2122 vcontact(cr) % Lweight(1,m) = lweight(1,ip)
2123 vcontact(cr) % Lweight(2,m) = lweight(2,ip)
2124 vcontact(cr) % Lweight(3,m) = lweight(3,ip)
2125 vcontact(cr) % Lweight(4,m) = lweight(4,ip)
2126# ifdef QUADRATIC_WEIGHTS
2128 vcontact(cr) % QweightUnmasked(1,m) = qweight(1,ip)
2129 vcontact(cr) % QweightUnmasked(2,m) = qweight(2,ip)
2130 vcontact(cr) % QweightUnmasked(3,m) = qweight(3,ip)
2131 vcontact(cr) % QweightUnmasked(4,m) = qweight(4,ip)
2132 vcontact(cr) % QweightUnmasked(5,m) = qweight(5,ip)
2133 vcontact(cr) % QweightUnmasked(6,m) = qweight(6,ip)
2134 vcontact(cr) % QweightUnmasked(7,m) = qweight(7,ip)
2135 vcontact(cr) % QweightUnmasked(8,m) = qweight(8,ip)
2136 vcontact(cr) % QweightUnmasked(9,m) = qweight(9,ip)
2138 vcontact(cr) % Qweight(1,m) = qweight(1,ip)
2139 vcontact(cr) % Qweight(2,m) = qweight(2,ip)
2140 vcontact(cr) % Qweight(3,m) = qweight(3,ip)
2141 vcontact(cr) % Qweight(4,m) = qweight(4,ip)
2142 vcontact(cr) % Qweight(5,m) = qweight(5,ip)
2143 vcontact(cr) % Qweight(6,m) = qweight(6,ip)
2144 vcontact(cr) % Qweight(7,m) = qweight(7,ip)
2145 vcontact(cr) % Qweight(8,m) = qweight(8,ip)
2146 vcontact(cr) % Qweight(9,m) = qweight(9,ip)
2180 dmem(ng)=
dmem(ng)+10.0_r8*real(npointsr(cr),r8)
2181 dmem(ng)=
dmem(ng)+ 3.0_r8*real(npointsu(cr),r8)
2182 dmem(ng)=
dmem(ng)+ 3.0_r8*real(npointsv(cr),r8)
2236 IF ((ibry.eq.
iwest ).or.(ibry.eq.
ieast ).or. &
2259 IF (.not.any(lcoincident).and.any(lcomposite))
THEN
2386 allocate (
composite(cr) % bustr(4,npointsu(cr)) )
2387 allocate (
composite(cr) % bvstr(4,npointsv(cr)) )
2389 allocate (
composite(cr) % ubar(4,npointsu(cr),2) )
2390 allocate (
composite(cr) % vbar(4,npointsv(cr),2) )
2391 allocate (
composite(cr) % zeta(4,npointsr(cr),2) )
2393 allocate (
composite(cr) % rzeta(4,npointsr(cr)) )
2395 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsr(cr),r8)
2396 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsu(cr),r8)
2397 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsv(cr),r8)
2399# if defined TANGENT || defined TL_IOMS
2400 allocate (
composite(cr) % tl_bustr(4,npointsu(cr)) )
2401 allocate (
composite(cr) % tl_bvstr(4,npointsv(cr)) )
2403 allocate (
composite(cr) % tl_ubar(4,npointsu(cr),2) )
2404 allocate (
composite(cr) % tl_vbar(4,npointsv(cr),2) )
2405 allocate (
composite(cr) % tl_zeta(4,npointsr(cr),2) )
2407 allocate (
composite(cr) % tl_rzeta(4,npointsr(cr)) )
2409 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsr(cr),r8)
2410 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsu(cr),r8)
2411 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsv(cr),r8)
2415 allocate (
composite(cr) % ad_bustr(4,npointsu(cr)) )
2416 allocate (
composite(cr) % ad_bvstr(4,npointsv(cr)) )
2418 allocate (
composite(cr) % ad_ubar(4,npointsu(cr),2) )
2419 allocate (
composite(cr) % ad_vbar(4,npointsv(cr),2) )
2420 allocate (
composite(cr) % ad_zeta(4,npointsr(cr),2) )
2422 allocate (
composite(cr) % ad_rzeta(4,npointsr(cr)) )
2424 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsr(cr),r8)
2425 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsu(cr),r8)
2426 dmem(dg)=
dmem(dg)+2.0_r8*real(4*npointsv(cr),r8)
2430 allocate (
composite(cr) % DU_avg1(4,npointsu(cr)) )
2431 allocate (
composite(cr) % DV_avg1(4,npointsv(cr)) )
2432 allocate (
composite(cr) % Zt_avg1(4,npointsr(cr)) )
2434 dmem(dg)=
dmem(dg)+real(4*npointsr(cr),r8)
2435 dmem(dg)=
dmem(dg)+real(4*npointsu(cr),r8)
2436 dmem(dg)=
dmem(dg)+real(4*npointsv(cr),r8)
2438 allocate (
composite(cr) % u(4,
n(dg),npointsu(cr)) )
2439 allocate (
composite(cr) % v(4,
n(dg),npointsv(cr)) )
2441 allocate (
composite(cr) % Huon(4,
n(dg),npointsu(cr)) )
2442 allocate (
composite(cr) % Hvom(4,
n(dg),npointsv(cr)) )
2444 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr),r8)
2445 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsv(cr),r8)
2447 allocate (
composite(cr) % t(4,
n(dg),npointsr(cr),
nt(dg)) )
2449 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr)*
nt(dg),r8)
2451# if defined TANGENT || defined TL_IOMS
2452 allocate (
composite(cr) % tl_DU_avg1(4,npointsu(cr)) )
2453 allocate (
composite(cr) % tl_DV_avg1(4,npointsv(cr)) )
2454 allocate (
composite(cr) % tl_Zt_avg1(4,npointsr(cr)) )
2456 dmem(dg)=
dmem(dg)+real(4*npointsr(cr),r8)
2457 dmem(dg)=
dmem(dg)+real(4*npointsu(cr),r8)
2458 dmem(dg)=
dmem(dg)+real(4*npointsv(cr),r8)
2460 allocate (
composite(cr) % tl_u(4,
n(dg),npointsu(cr)) )
2461 allocate (
composite(cr) % tl_v(4,
n(dg),npointsv(cr)) )
2463 allocate (
composite(cr) % tl_Huon(4,
n(dg),npointsu(cr)) )
2464 allocate (
composite(cr) % tl_Hvom(4,
n(dg),npointsv(cr)) )
2466 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr),r8)
2467 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsv(cr),r8)
2469 allocate (
composite(cr) % tl_t(4,
n(dg),npointsr(cr),
nt(dg)) )
2471 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr)*
nt(dg),r8)
2475 allocate (
composite(cr) % ad_DU_avg1(4,npointsu(cr)) )
2476 allocate (
composite(cr) % ad_DV_avg1(4,npointsv(cr)) )
2477 allocate (
composite(cr) % ad_Zt_avg1(4,npointsr(cr)) )
2479 dmem(dg)=
dmem(dg)+real(4*npointsr(cr),r8)
2480 dmem(dg)=
dmem(dg)+real(4*npointsu(cr),r8)
2481 dmem(dg)=
dmem(dg)+real(4*npointsv(cr),r8)
2483 allocate (
composite(cr) % ad_u(4,
n(dg),npointsu(cr)) )
2484 allocate (
composite(cr) % ad_v(4,
n(dg),npointsv(cr)) )
2486 allocate (
composite(cr) % ad_Huon(4,
n(dg),npointsu(cr)) )
2487 allocate (
composite(cr) % ad_Hvom(4,
n(dg),npointsv(cr)) )
2489 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr),r8)
2490 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsv(cr),r8)
2492 allocate (
composite(cr) % ad_t(4,
n(dg),npointsr(cr),
nt(dg)) )
2494 dmem(dg)=
dmem(dg)+2.0_r8*real(4*
n(dg)*npointsu(cr)*
nt(dg),r8)
2515 allocate (
refined(cr) % ubar(4,npointsu(cr),2) )
2516 allocate (
refined(cr) % vbar(4,npointsv(cr),2) )
2517 allocate (
refined(cr) % zeta(4,npointsr(cr),2) )
2519 allocate (
refined(cr) % U2d_flux(4,npointsu(cr),2) )
2520 allocate (
refined(cr) % V2d_flux(4,npointsv(cr),2) )
2522 allocate (
refined(cr) % on_u(npointsu(cr)) )
2523 allocate (
refined(cr) % om_v(npointsv(cr)) )
2525 dmem(rg)=
dmem(rg)+real(4*npointsr(cr),r8)
2526 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsu(cr),r8)
2527 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsv(cr),r8)
2529# if defined TANGENT || defined TL_IOMS
2530 allocate (
refined(cr) % tl_ubar(4,npointsu(cr),2) )
2531 allocate (
refined(cr) % tl_vbar(4,npointsv(cr),2) )
2532 allocate (
refined(cr) % tl_zeta(4,npointsr(cr),2) )
2534 allocate (
refined(cr) % tl_U2d_flux(4,npointsu(cr),2) )
2535 allocate (
refined(cr) % tl_V2d_flux(4,npointsv(cr),2) )
2537 dmem(rg)=
dmem(rg)+real(4*npointsr(cr),r8)
2538 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsu(cr),r8)
2539 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsv(cr),r8)
2543 allocate (
refined(cr) % ad_ubar(4,npointsu(cr),2) )
2544 allocate (
refined(cr) % ad_vbar(4,npointsv(cr),2) )
2545 allocate (
refined(cr) % ad_zeta(4,npointsr(cr),2) )
2547 allocate (
refined(cr) % ad_U2d_flux(4,npointsu(cr),2) )
2548 allocate (
refined(cr) % ad_V2d_flux(4,npointsv(cr),2) )
2550 dmem(rg)=
dmem(rg)+real(4*npointsr(cr),r8)
2551 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsu(cr),r8)
2552 dmem(rg)=
dmem(rg)+3.0_r8*real(4*npointsv(cr),r8)
2556 allocate (
refined(cr) % u(4,
n(rg),npointsu(cr),2) )
2557 allocate (
refined(cr) % v(4,
n(rg),npointsv(cr),2) )
2559 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsu(cr),r8)
2560 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsv(cr),r8)
2562 allocate (
refined(cr) % t(4,
n(rg),npointsr(cr),2,
nt(rg)) )
2564 dmem(rg)=
dmem(rg)+2.0_r8*real(4*
n(rg)*npointsr(cr)*
nt(rg),r8)
2566# if defined TANGENT || defined TL_IOMS
2567 allocate (
refined(cr) % tl_u(4,
n(rg),npointsu(cr),2) )
2568 allocate (
refined(cr) % tl_v(4,
n(rg),npointsv(cr),2) )
2570 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsu(cr),r8)
2571 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsv(cr),r8)
2573 allocate (
refined(cr) % tl_t(4,
n(rg),npointsr(cr),2,
nt(rg)) )
2575 dmem(rg)=
dmem(rg)+2.0_r8*real(4*
n(rg)*npointsr(cr)*
nt(rg),r8)
2579 allocate (
refined(cr) % ad_u(4,
n(rg),npointsu(cr),2) )
2580 allocate (
refined(cr) % ad_v(4,
n(rg),npointsv(cr),2) )
2582 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsu(cr),r8)
2583 dmem(rg)=
dmem(rg)+3.0_r8*real(4*
n(rg)*npointsv(cr),r8)
2585 allocate (
refined(cr) % ad_t(4,
n(rg),npointsr(cr),2,
nt(rg)) )
2587 dmem(rg)=
dmem(rg)+2.0_r8*real(4*
n(rg)*npointsr(cr)*
nt(rg),r8)