69 & LBi, UBi, LBj, UBj, LBk, UBk, &
70 & IminS, ImaxS, JminS, JmaxS, &
71 & Nghost, NHsteps, NVsteps, &
75# ifdef GEOPOTENTIAL_HCONV
81 & rmask, umask, vmask, &
97 integer,
intent(in) :: ng, tile, model
98 integer,
intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
99 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
100 integer,
intent(in) :: Nghost, NHsteps, NVsteps
102 real(r8),
intent(in) :: DTsizeH, DTsizeV
105 real(r8),
intent(in) :: pm(LBi:,LBj:)
106 real(r8),
intent(in) :: pn(LBi:,LBj:)
107# ifdef GEOPOTENTIAL_HCONV
108 real(r8),
intent(in) :: on_u(LBi:,LBj:)
109 real(r8),
intent(in) :: om_v(LBi:,LBj:)
111 real(r8),
intent(in) :: pmon_u(LBi:,LBj:)
112 real(r8),
intent(in) :: pnom_v(LBi:,LBj:)
115 real(r8),
intent(in) :: rmask(LBi:,LBj:)
116 real(r8),
intent(in) :: umask(LBi:,LBj:)
117 real(r8),
intent(in) :: vmask(LBi:,LBj:)
119 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
120 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
122 real(r8),
intent(in) :: Kh(LBi:,LBj:)
123 real(r8),
intent(in) :: Kv(LBi:,LBj:,0:)
125 real(r8),
intent(inout) :: ad_A(LBi:,LBj:,LBk:)
127 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
128 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
129# ifdef GEOPOTENTIAL_HCONV
130 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
131 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
133 real(r8),
intent(in) :: pmon_u(LBi:UBi,LBj:UBj)
134 real(r8),
intent(in) :: pnom_v(LBi:UBi,LBj:UBj)
137 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
138 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
139 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
141 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
142 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
144 real(r8),
intent(in) :: Kh(LBi:UBi,LBj:UBj)
145 real(r8),
intent(in) :: Kv(LBi:UBi,LBj:UBj,0:UBk)
147 real(r8),
intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
152 integer :: Nnew, Nold, Nsav
153 integer :: i, j, k, kk, kt, k1, k1b, k2, k2b, step
155 real(r8) :: adfac, adfac1, adfac2
156 real(r8) :: cff, cff1, cff2, cff3, cff4
158 real(r8),
dimension(LBi:UBi,LBj:UBj,LBk:UBk,2) :: ad_Awrk
160 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
161 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FE
162 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FX
164# ifndef SPLINES_VCONV
165 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: FC
167# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
168 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: oHz
170# if defined IMPLICIT_VCONV || defined SPLINES_VCONV
171 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: BC
172 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: CF
174 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
176 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: ad_DC
178 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: ad_FS
181# ifdef GEOPOTENTIAL_HCONV
182 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx
183 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde
184 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_FZ
185 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAdz
186 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAdx
187 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAde
190# include "set_bounds.h"
196 ad_awrk(lbi:ubi,lbj:ubj,lbk:ubk,1:2)=0.0_r8
198# ifdef IMPLICIT_VCONV
199 ad_dc(imins:imaxs,0:n(ng))=0.0_r8
201 ad_fs(imins:imaxs,0:n(ng))=0.0_r8
204 ad_fe(imins:imaxs,jmins:jmaxs)=0.0_r8
205 ad_fx(imins:imaxs,jmins:jmaxs)=0.0_r8
206# ifdef GEOPOTENTIAL_HCONV
207 ad_fz(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
208 ad_dadz(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
209 ad_dadx(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
210 ad_dade(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
224 hfac(i,j)=dtsizeh*pm(i,j)*pn(i,j)
226# ifndef SPLINES_VCONV
229# ifdef IMPLICIT_VCONV
230 fc(i,j,k)=-dtsizev*kv(i,j,k)/(z_r(i,j,k+1)-z_r(i,j,k))
232 fc(i,j,k)=dtsizev*kv(i,j,k)/(z_r(i,j,k+1)-z_r(i,j,k))
237# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
239 ohz(i,j,k)=1.0_r8/hz(i,j,k)
260 & lbi, ubi, lbj, ubj, lbk, ubk, &
270 & lbi, ubi, lbj, ubj, lbk, ubk, &
277 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ad_a(i,j,k)
284# ifdef IMPLICIT_VCONV
311 fc(i,k)=cff1*hz(i,j,k )- &
312 & dtsizev*kv(i,j,k-1)*ohz(i,j,k )
313 cf(i,k)=cff1*hz(i,j,k+1)- &
314 & dtsizev*kv(i,j,k+1)*ohz(i,j,k+1)
324 bc(i,k)=cff1*(hz(i,j,k)+hz(i,j,k+1))+ &
325 & dtsizev*kv(i,j,k)*(ohz(i,j,k)+ohz(i,j,k+1))
326 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
339 adfac=dtsizev*ohz(i,j,k)*ad_awrk(i,j,k,nnew)
340 ad_dc(i,k-1)=ad_dc(i,k-1)-adfac
341 ad_dc(i,k )=ad_dc(i,k )+adfac
342 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
343 & ad_awrk(i,j,k,nnew)
344 ad_awrk(i,j,k,nnew)=0.0_r8
347 ad_dc(i,k)=ad_dc(i,k)*kv(i,j,k)
354 ad_dc(i,k+1)=ad_dc(i,k+1)-cf(i,k)*ad_dc(i,k)
360 ad_dc(i,n(ng))=0.0_r8
367 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
373 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
374 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
375 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k)*adfac
407 bc(i,k)=hz(i,j,k)-fc(i,j,k)-fc(i,j,k-1)
415 cf(i,1)=cff*fc(i,j,1)
419 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
420 cf(i,k)=cff*fc(i,j,k)
430 ad_awrk(i,j,k,nnew)=ad_awrk(i,j,k,nnew)*rmask(i,j)
434 ad_dc(i,k)=ad_dc(i,k)+ &
435 & ad_awrk(i,j,k,nnew)
436 ad_awrk(i,j,k,nnew)=0.0_r8
439 ad_dc(i,k+1)=-cf(i,k)*ad_dc(i,k)
446 ad_awrk(i,j,n(ng),nnew)=ad_awrk(i,j,n(ng),nnew)*rmask(i,j)
450 ad_dc(i,n(ng))=ad_dc(i,n(ng))+ &
451 & ad_awrk(i,j,n(ng),nnew)
452 ad_awrk(i,j,n(ng),nnew)=0.0_r8
457 adfac=ad_dc(i,n(ng))/ &
458 & (bc(i,n(ng))-fc(i,j,n(ng)-1)*cf(i,n(ng)-1))
459 ad_dc(i,n(ng)-1)=ad_dc(i,n(ng)-1)-fc(i,j,n(ng)-1)*adfac
460 ad_dc(i,n(ng) )=adfac
469 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
473 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,j,k-1)*adfac
481 ad_dc(i,1)=cff*ad_dc(i,1)
490 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
491 & hz(i,j,k)*ad_dc(i,k)
523 adfac=ohz(i,j,k)*ad_awrk(i,j,k,nnew)
524 ad_fs(i,k-1)=ad_fs(i,k-1)-adfac
525 ad_fs(i,k )=ad_fs(i,k )+adfac
526 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
527 & ad_awrk(i,j,k,nnew)
528 ad_awrk(i,j,k,nnew)=0.0_r8
538 ad_fs(i,n(ng))=0.0_r8
548 ad_fs(i,k)=ad_fs(i,k)*rmask(i,j)
553 adfac=fc(i,j,k)*ad_fs(i,k)
554 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
555 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
586 & lbi, ubi, lbj, ubj, lbk, ubk, &
589 & ad_awrk(:,:,:,nnew))
596 & lbi, ubi, lbj, ubj, lbk, ubk, &
597 & ad_awrk(:,:,:,nnew))
599# ifdef GEOPOTENTIAL_HCONV
628 k_loop :
DO k=n(ng),0,-1
641 IF (kk.lt.n(ng))
THEN
644 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
648 dzdx(i,j,k2)=cff*(z_r(i ,j,kk+1)- &
661 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
665 dzde(i,j,k2)=cff*(z_r(i,j ,kk+1)- &
692 adfac1=hfac(i,j)*ad_awrk(i,j,k,nnew)
693 adfac2=dtsizeh*ad_awrk(i,j,k,nnew)
694 ad_fe(i,j )=ad_fe(i,j )-adfac1
695 ad_fe(i,j+1)=ad_fe(i,j+1)+adfac1
696 ad_fx(i ,j)=ad_fx(i ,j)-adfac1
697 ad_fx(i+1,j)=ad_fx(i+1,j)+adfac1
698 ad_fz(i,j,k1)=ad_fz(i,j,k1)-adfac2
699 ad_fz(i,j,k2)=ad_fz(i,j,k2)+adfac2
700 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
701 & ad_awrk(i,j,k,nnew)
702 ad_awrk(i,j,k,nnew)=0.0_r8
713 cff1=min(dzde(i,j ,k1),0.0_r8)
714 cff2=min(dzde(i,j+1,k2),0.0_r8)
715 cff3=max(dzde(i,j ,k2),0.0_r8)
716 cff4=max(dzde(i,j+1,k1),0.0_r8)
728 adfac=cff*ad_fz(i,j,k2)
729 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)+ &
734 ad_dade(i,j ,k1)=ad_dade(i,j ,k1)-cff1*adfac
735 ad_dade(i,j+1,k2)=ad_dade(i,j+1,k2)-cff2*adfac
736 ad_dade(i,j ,k2)=ad_dade(i,j ,k2)-cff3*adfac
737 ad_dade(i,j+1,k1)=ad_dade(i,j+1,k1)-cff4*adfac
739 cff1=min(dzdx(i ,j,k1),0.0_r8)
740 cff2=min(dzdx(i+1,j,k2),0.0_r8)
741 cff3=max(dzdx(i ,j,k2),0.0_r8)
742 cff4=max(dzdx(i+1,j,k1),0.0_r8)
753 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)+ &
758 ad_dadx(i ,j,k1)=ad_dadx(i ,j,k1)-cff1*adfac
759 ad_dadx(i+1,j,k2)=ad_dadx(i+1,j,k2)-cff2*adfac
760 ad_dadx(i ,j,k2)=ad_dadx(i ,j,k2)-cff3*adfac
761 ad_dadx(i+1,j,k1)=ad_dadx(i+1,j,k1)-cff4*adfac
768 cff=0.25_r8*(kh(i,j-1)+kh(i,j))*om_v(i,j)
769 cff1=min(dzde(i,j,k1),0.0_r8)
770 cff2=max(dzde(i,j,k1),0.0_r8)
779 adfac=cff*(hz(i,j,k)+hz(i,j-1,k))*ad_fe(i,j)
780 adfac1=adfac*0.5_r8*cff1
781 adfac2=adfac*0.5_r8*cff2
782 ad_dade(i,j,k1)=ad_dade(i,j,k1)+adfac
783 ad_dadz(i,j-1,k1)=ad_dadz(i,j-1,k1)-adfac1
784 ad_dadz(i,j ,k2)=ad_dadz(i,j ,k2)-adfac1
785 ad_dadz(i,j-1,k2)=ad_dadz(i,j-1,k2)-adfac2
786 ad_dadz(i,j ,k1)=ad_dadz(i,j ,k1)-adfac2
792 cff=0.25_r8*(kh(i-1,j)+kh(i-1,j))*on_u(i,j)
793 cff1=min(dzdx(i,j,k1),0.0_r8)
794 cff2=max(dzdx(i,j,k1),0.0_r8)
803 adfac=cff*(hz(i,j,k)+hz(i-1,j,k))*ad_fx(i,j)
804 adfac1=adfac*0.5_r8*cff1
805 adfac2=adfac*0.5_r8*cff2
806 ad_dadx(i,j,k1)=ad_dadx(i,j,k1)+adfac
807 ad_dadz(i-1,j,k1)=ad_dadz(i-1,j,k1)-adfac1
808 ad_dadz(i ,j,k2)=ad_dadz(i ,j,k2)-adfac1
809 ad_dadz(i-1,j,k2)=ad_dadz(i-1,j,k2)-adfac2
810 ad_dadz(i ,j,k1)=ad_dadz(i ,j,k1)-adfac2
815 IF ((k.eq.0).or.(k.eq.n(ng)))
THEN
823 ad_dadz(i,j,k2)=0.0_r8
829 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
833 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)*rmask(i,j)
838 adfac=cff*ad_dadz(i,j,k2)
839 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
840 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
841 ad_dadz(i,j,k2)=0.0_r8
848 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
855 adfac=cff*ad_dade(i,j,k2)
856 ad_awrk(i,j-1,k+1,nold)=ad_awrk(i,j-1,k+1,nold)- &
858 ad_awrk(i,j ,k+1,nold)=ad_awrk(i,j ,k+1,nold)+ &
860 ad_dade(i,j,k2)=0.0_r8
865 adfac=cff*ad_dade(i,j,k2)
866 ad_awrk(i,j-1,k+1,nold)=ad_awrk(i,j-1,k+1,nold)-adfac
867 ad_awrk(i,j ,k+1,nold)=ad_awrk(i,j ,k+1,nold)+adfac
868 ad_dade(i,j,k2)=0.0_r8
874 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
880 adfac=cff*ad_dadx(i,j,k2)
881 ad_awrk(i-1,j,k+1,nold)=ad_awrk(i-1,j,k+1,nold)- &
883 ad_awrk(i ,j,k+1,nold)=ad_awrk(i ,j,k+1,nold)+ &
885 ad_dadx(i,j,k2)=0.0_r8
890 adfac=cff*ad_dadx(i,j,k2)
891 ad_awrk(i-1,j,k+1,nold)=ad_awrk(i-1,j,k+1,nold)-adfac
892 ad_awrk(i ,j,k+1,nold)=ad_awrk(i ,j,k+1,nold)+adfac
893 ad_dadx(i,j,k2)=0.0_r8
918 adfac=hfac(i,j)*ad_awrk(i,j,k,nnew)
919 ad_fe(i,j )=ad_fe(i,j )-adfac
920 ad_fe(i,j+1)=ad_fe(i,j+1)+adfac
921 ad_fx(i ,j)=ad_fx(i ,j)-adfac
922 ad_fx(i+1,j)=ad_fx(i+1,j)+adfac
923 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
924 & ad_awrk(i,j,k,nnew)
925 ad_awrk(i,j,k,nnew)=0.0_r8
936 ad_fe(i,j)=ad_fe(i,j)*vmask(i,j)
941 adfac=pnom_v(i,j)*0.5_r8*(kh(i,j-1)+kh(i,j))*ad_fe(i,j)
942 ad_awrk(i,j-1,k,nold)=ad_awrk(i,j-1,k,nold)-adfac
943 ad_awrk(i,j ,k,nold)=ad_awrk(i,j ,k,nold)+adfac
952 ad_fx(i,j)=ad_fx(i,j)*umask(i,j)
957 adfac=pmon_u(i,j)*0.5_r8*(kh(i-1,j)+kh(i,j))*ad_fx(i,j)
958 ad_awrk(i-1,j,k,nold)=ad_awrk(i-1,j,k,nold)-adfac
959 ad_awrk(i ,j,k,nold)=ad_awrk(i ,j,k,nold)+adfac
976 ad_a(i,j,k)=ad_a(i,j,k)+ad_awrk(i,j,k,nold)
977 ad_awrk(i,j,k,nold)=0.0_r8
989 & lbi, ubi, lbj, ubj, lbk, ubk, &
999 & lbi, ubi, lbj, ubj, lbk, ubk, &
1007 & LBi, UBi, LBj, UBj, LBk, UBk, &
1008 & IminS, ImaxS, JminS, JmaxS, &
1009 & Nghost, NHsteps, NVsteps, &
1010 & DTsizeH, DTsizeV, &
1013# ifdef GEOPOTENTIAL_HCONV
1019# ifdef GEOPOTENTIAL_HCONV
1020 & pmask, rmask, umask, vmask, &
1039 integer,
intent(in) :: ng, tile, model
1040 integer,
intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
1041 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
1042 integer,
intent(in) :: Nghost, NHsteps, NVsteps
1044 real(r8),
intent(in) :: DTsizeH, DTsizeV
1046# ifdef ASSUMED_SHAPE
1047 real(r8),
intent(in) :: pm(LBi:,LBj:)
1048 real(r8),
intent(in) :: pn(LBi:,LBj:)
1049# ifdef GEOPOTENTIAL_HCONV
1050 real(r8),
intent(in) :: on_r(LBi:,LBj:)
1051 real(r8),
intent(in) :: om_p(LBi:,LBj:)
1053 real(r8),
intent(in) :: pmon_r(LBi:,LBj:)
1054 real(r8),
intent(in) :: pnom_p(LBi:,LBj:)
1057# ifdef GEOPOTENTIAL_HCONV
1058 real(r8),
intent(in) :: pmask(LBi:,LBj:)
1059 real(r8),
intent(in) :: rmask(LBi:,LBj:)
1060 real(r8),
intent(in) :: umask(LBi:,LBj:)
1061 real(r8),
intent(in) :: vmask(LBi:,LBj:)
1063 real(r8),
intent(in) :: umask(LBi:,LBj:)
1064 real(r8),
intent(in) :: pmask(LBi:,LBj:)
1067 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
1068 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
1070 real(r8),
intent(in) :: Kh(LBi:,LBj:)
1071 real(r8),
intent(in) :: Kv(LBi:,LBj:,0:)
1073 real(r8),
intent(inout) :: ad_A(LBi:,LBj:,LBk:)
1075 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
1076 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
1077# ifdef GEOPOTENTIAL_HCONV
1078 real(r8),
intent(in) :: on_r(LBi:UBi,LBj:UBj)
1079 real(r8),
intent(in) :: om_p(LBi:UBi,LBj:UBj)
1081 real(r8),
intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
1082 real(r8),
intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
1085# ifdef GEOPOTENTIAL_HCONV
1086 real(r8),
intent(in) :: pmask(LBi:UBi,LBj:UBj)
1087 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
1088 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
1089 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
1091 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
1092 real(r8),
intent(in) :: pmask(LBi:UBi,LBj:UBj)
1095 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
1096 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
1098 real(r8),
intent(in) :: Kh(LBi:UBi,LBj:UBj)
1099 real(r8),
intent(in) :: Kv(LBi:UBi,LBj:UBj,0:UBk)
1101 real(r8),
intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
1106 integer :: Nnew, Nold, Nsav
1107 integer :: i, j, k, kk, kt, k1, k1b, k2, k2b, step
1109 real(r8) :: adfac, adfac1, adfac2
1110 real(r8) :: cff, cff1, cff2, cff3, cff4
1112 real(r8),
dimension(LBi:UBi,LBj:UBj,LBk:UBk,2) :: ad_Awrk
1114 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
1115 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FE
1116 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FX
1118# ifndef SPLINES_VCONV
1119 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: FC
1121# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
1122 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: oHz
1124# if defined IMPLICIT_VCONV || defined SPLINES_VCONV
1125 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: BC
1126 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: CF
1127# ifdef SPLINES_VCONV
1128 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
1129 real(r8),
dimension(IminS:ImaxS,N(ng)) :: Hzk
1131 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: ad_DC
1133 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: ad_FS
1136# ifdef GEOPOTENTIAL_HCONV
1137 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: dZdx
1138 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: dZde
1140 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_r
1141 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_p
1142 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_FZ
1143 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAdz
1144 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAdx
1145 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAde
1148# include "set_bounds.h"
1154 ad_awrk(lbi:ubi,lbj:ubj,lbk:ubk,1:2)=0.0_r8
1156# ifdef IMPLICIT_VCONV
1157 ad_dc(imins:imaxs,0:n(ng))=0.0_r8
1159 ad_fs(imins:imaxs,0:n(ng))=0.0_r8
1162 ad_fe(imins:imaxs,jmins:jmaxs)=0.0_r8
1163 ad_fx(imins:imaxs,jmins:jmaxs)=0.0_r8
1164# ifdef GEOPOTENTIAL_HCONV
1165 ad_fz(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
1166 ad_dadz(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
1167 ad_dadx(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
1168 ad_dade(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
1183 hfac(i,j)=cff*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
1185# ifndef SPLINES_VCONV
1186 fc(i,j,n(ng))=0.0_r8
1188# ifdef IMPLICIT_VCONV
1189 fc(i,j,k)=-dtsizev*(kv(i-1,j,k)+kv(i,j,k))/ &
1190 & (z_r(i-1,j,k+1)+z_r(i,j,k+1)- &
1191 & z_r(i-1,j,k )-z_r(i,j,k ))
1193 fc(i,j,k)=dtsizev*(kv(i-1,j,k)+kv(i,j,k))/ &
1194 & (z_r(i-1,j,k+1)+z_r(i,j,k+1)- &
1195 & z_r(i-1,j,k )-z_r(i,j,k ))
1200# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
1202 ohz(i,j,k)=2.0_r8/(hz(i-1,j,k)+hz(i,j,k))
1223 & lbi, ubi, lbj, ubj, lbk, ubk, &
1233 & lbi, ubi, lbj, ubj, lbk, ubk, &
1240 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ad_a(i,j,k)
1247# ifdef IMPLICIT_VCONV
1248# ifdef SPLINES_VCONV
1272 hzk(i,k)=0.5_r8*(hz(i-1,j,k)+ &
1279 fc(i,k)=cff1*hzk(i,k )-dtsizev*kv(i,j,k-1)*ohz(i,j,k )
1280 cf(i,k)=cff1*hzk(i,k+1)-dtsizev*kv(i,j,k+1)*ohz(i,j,k+1)
1290 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
1291 & dtsizev*kv(i,j,k)*(ohz(i,j,k)+ohz(i,j,k+1))
1292 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
1305 adfac=dtsizev*ohz(i,j,k)*ad_awrk(i,j,k,nnew)
1306 ad_dc(i,k-1)=ad_dc(i,k-1)-adfac
1307 ad_dc(i,k )=ad_dc(i,k )+adfac
1308 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
1309 & ad_awrk(i,j,k,nnew)
1310 ad_awrk(i,j,k,nnew)=0.0_r8
1313 ad_dc(i,k)=ad_dc(i,k)*kv(i,j,k)
1320 ad_dc(i,k+1)=ad_dc(i,k+1)-cf(i,k)*ad_dc(i,k)
1326 ad_dc(i,n(ng))=0.0_r8
1333 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
1338 adfac=cff*ad_dc(i,k)
1339 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
1340 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
1341 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k)*adfac
1371 bc(i,k)=0.5*(hz(i-1,j,k)+hz(i,j,k))- &
1372 & fc(i,j,k)-fc(i,j,k-1)
1380 cf(i,1)=cff*fc(i,j,1)
1384 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
1385 cf(i,k)=cff*fc(i,j,k)
1395 ad_awrk(i,j,k,nnew)=ad_awrk(i,j,k,nnew)*umask(i,j)
1399 ad_dc(i,k)=ad_dc(i,k)+ &
1400 & ad_awrk(i,j,k,nnew)
1401 ad_awrk(i,j,k,nnew)=0.0_r8
1404 ad_dc(i,k+1)=-cf(i,k)*ad_dc(i,k)
1411 ad_awrk(i,j,n(ng),nnew)=ad_awrk(i,j,n(ng),nnew)*umask(i,j)
1415 ad_dc(i,n(ng))=ad_dc(i,n(ng))+ &
1416 & ad_awrk(i,j,n(ng),nnew)
1417 ad_awrk(i,j,n(ng),nnew)=0.0_r8
1422 adfac=ad_dc(i,n(ng))/ &
1423 & (bc(i,n(ng))-fc(i,j,n(ng)-1)*cf(i,n(ng)-1))
1424 ad_dc(i,n(ng)-1)=ad_dc(i,n(ng)-1)-fc(i,j,n(ng)-1)*adfac
1425 ad_dc(i,n(ng) )=adfac
1434 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
1437 adfac=cff*ad_dc(i,k)
1438 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,j,k-1)*adfac
1446 ad_dc(i,1)=cff*ad_dc(i,1)
1453 cff=0.5*(hz(i-1,j,k)+hz(i,j,k))
1456 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+cff*ad_dc(i,k)
1487 adfac=ohz(i,j,k)*ad_awrk(i,j,k,nnew)
1488 ad_fs(i,k-1)=ad_fs(i,k-1)-adfac
1489 ad_fs(i,k )=ad_fs(i,k )+adfac
1490 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
1491 & ad_awrk(i,j,k,nnew)
1492 ad_awrk(i,j,k,nnew)=0.0_r8
1502 ad_fs(i,n(ng))=0.0_r8
1512 ad_fs(i,k)=ad_fs(i,k)*umask(i,j)
1517 adfac=fc(i,j,k)*ad_fs(i,k)
1518 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
1519 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
1550 & lbi, ubi, lbj, ubj, lbk, ubk, &
1553 & ad_awrk(:,:,:,nnew))
1560 & lbi, ubi, lbj, ubj, lbk, ubk, &
1561 & ad_awrk(:,:,:,nnew))
1563# ifdef GEOPOTENTIAL_HCONV
1592 k_loop :
DO k=n(ng),0,-1
1605 IF (kk.lt.n(ng))
THEN
1608 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
1612 dzdx(i,j)=cff*(z_r(i ,j,kk+1)- &
1618 dzdx_r(i,j,k2)=0.5_r8*(dzdx(i ,j)+ &
1625 dzdx_r(i,j,k1b)=0.0_r8
1632 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
1636 dzde(i,j)=cff*(z_r(i,j ,kk+1)- &
1642 dzde_p(i,j,k2)=0.5_r8*(dzde(i-1,j)+ &
1649 dzde_p(i,j,k1b)=0.0_r8
1669 adfac1=hfac(i,j)*ad_awrk(i,j,k,nnew)
1670 adfac2=dtsizeh*ad_awrk(i,j,k,nnew)
1671 ad_fe(i,j )=ad_fe(i,j )-adfac1
1672 ad_fe(i,j+1)=ad_fe(i,j+1)+adfac1
1673 ad_fx(i-1,j)=ad_fx(i-1,j)-adfac1
1674 ad_fx(i ,j)=ad_fx(i ,j)+adfac1
1675 ad_fz(i,j,k1)=ad_fz(i,j,k1)-adfac2
1676 ad_fz(i,j,k2)=ad_fz(i,j,k2)+adfac2
1677 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
1678 & ad_awrk(i,j,k,nnew)
1679 ad_awrk(i,j,k,nnew)=0.0_r8
1686 IF (k.lt.n(ng))
THEN
1689 cff=0.25_r8*(kh(i-1,j)+kh(i,j))
1690 cff1=min(dzde_p(i,j ,k1),0.0_r8)
1691 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
1692 cff3=max(dzde_p(i,j ,k2),0.0_r8)
1693 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
1705 adfac=cff*ad_fz(i,j,k2)
1706 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)+ &
1711 ad_dade(i,j ,k1)=ad_dade(i,j ,k1)-cff1*adfac
1712 ad_dade(i,j+1,k2)=ad_dade(i,j+1,k2)-cff2*adfac
1713 ad_dade(i,j ,k2)=ad_dade(i,j ,k2)-cff3*adfac
1714 ad_dade(i,j+1,k1)=ad_dade(i,j+1,k1)-cff4*adfac
1716 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
1717 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
1718 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
1719 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
1730 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)+ &
1735 ad_dadx(i-1,j,k1)=ad_dadx(i-1,j,k1)-cff1*adfac
1736 ad_dadx(i ,j,k2)=ad_dadx(i ,j,k2)-cff2*adfac
1737 ad_dadx(i-1,j,k2)=ad_dadx(i-1,j,k2)-cff3*adfac
1738 ad_dadx(i ,j,k1)=ad_dadx(i ,j,k1)-cff4*adfac
1739 ad_fz(i,j,k2)=0.0_r8
1745 cff=0.0625_r8*(kh(i-1,j-1)+kh(i-1,j)+ &
1746 & kh(i ,j-1)+kh(i ,j))*om_p(i,j)
1747 cff1=min(dzde_p(i,j,k1),0.0_r8)
1748 cff2=max(dzde_p(i,j,k1),0.0_r8)
1758 adfac=cff*(hz(i-1,j-1,k)+hz(i-1,j,k)+ &
1759 & hz(i ,j-1,k)+hz(i ,j,k))*ad_fe(i,j)
1760 adfac1=adfac*0.5_r8*cff1
1761 adfac2=adfac*0.5_r8*cff2
1762 ad_dade(i,j,k1)=ad_dade(i,j,k1)+adfac
1763 ad_dadz(i,j-1,k1)=ad_dadz(i,j-1,k1)-adfac1
1764 ad_dadz(i,j ,k2)=ad_dadz(i,j ,k2)-adfac1
1765 ad_dadz(i,j-1,k2)=ad_dadz(i,j-1,k2)-adfac2
1766 ad_dadz(i,j ,k1)=ad_dadz(i,j ,k1)-adfac2
1772 cff=kh(i,j)*on_r(i,j)
1773 cff1=min(dzdx_r(i,j,k1),0.0_r8)
1774 cff2=max(dzdx_r(i,j,k1),0.0_r8)
1783 adfac=cff*hz(i,j,k)*ad_fx(i,j)
1784 adfac1=adfac*0.5_r8*cff1
1785 adfac2=adfac*0.5_r8*cff2
1786 ad_dadx(i,j,k1)=ad_dadx(i,j,k1)+adfac
1787 ad_dadz(i ,j,k1)=ad_dadz(i ,j,k1)-adfac1
1788 ad_dadz(i+1,j,k2)=ad_dadz(i+1,j,k2)-adfac1
1789 ad_dadz(i ,j,k2)=ad_dadz(i ,j,k2)-adfac2
1790 ad_dadz(i+1,j,k1)=ad_dadz(i+1,j,k1)-adfac2
1795 IF ((k.eq.0).or.(k.eq.n(ng)))
THEN
1800 ad_fz(i,j,k2)=0.0_r8
1803 ad_dadz(i,j,k2)=0.0_r8
1809 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
1813 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)*umask(i,j)
1818 adfac=cff*ad_dadz(i,j,k2)
1819 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
1820 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
1821 ad_dadz(i,j,k2)=0.0_r8
1825 IF (k.lt.n(ng))
THEN
1828 cff=0.25_r8*(pn(i-1,j )+pn(i,j )+ &
1829 & pn(i-1,j-1)+pn(i,j-1))
1833 ad_dade(i,j,k2)=ad_dade(i,j,k2)*pmask(i,j)
1838 adfac=cff*ad_dade(i,j,k2)
1839 ad_awrk(i,j ,k+1,nold)=ad_awrk(i,j ,k+1,nold)+ &
1841 ad_awrk(i,j-1,k+1,nold)=ad_awrk(i,j-1,k+1,nold)- &
1842 & umask(i,j-1)*adfac
1843 ad_dade(i,j,k2)=0.0_r8
1848 adfac=cff*ad_dade(i,j,k2)
1849 ad_awrk(i,j ,k+1,nold)=ad_awrk(i,j ,k+1,nold)+ &
1851 ad_awrk(i,j-1,k+1,nold)=ad_awrk(i,j-1,k+1,nold)- &
1853 ad_dade(i,j,k2)=0.0_r8
1862 ad_dadx(i,j,k2)=ad_dadx(i,j,k2)*rmask(i,j)
1867 adfac=pm(i,j)*ad_dadx(i,j,k2)
1868 ad_awrk(i ,j,k+1,nold)=ad_awrk(i ,j,k+1,nold)- &
1870 ad_awrk(i+1,j,k+1,nold)=ad_awrk(i+1,j,k+1,nold)+ &
1871 & umask(i+1,j)*adfac
1872 ad_dadx(i,j,k2)=0.0_r8
1877 adfac=pm(i,j)*ad_dadx(i,j,k2)
1878 ad_awrk(i ,j,k+1,nold)=ad_awrk(i ,j,k+1,nold)- &
1880 ad_awrk(i+1,j,k+1,nold)=ad_awrk(i+1,j,k+1,nold)+ &
1882 ad_dadx(i,j,k2)=0.0_r8
1907 adfac=hfac(i,j)*ad_awrk(i,j,k,nnew)
1908 ad_fe(i,j )=ad_fe(i,j )-adfac
1909 ad_fe(i,j+1)=ad_fe(i,j+1)+adfac
1910 ad_fx(i-1,j)=ad_fx(i-1,j)-adfac
1911 ad_fx(i ,j)=ad_fx(i ,j)+adfac
1912 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
1913 & ad_awrk(i,j,k,nnew)
1914 ad_awrk(i,j,k,nnew)=0.0_r8
1925 ad_fe(i,j)=ad_fe(i,j)*pmask(i,j)
1931 adfac=pnom_p(i,j)*0.25_r8*(kh(i-1,j )+kh(i,j )+ &
1932 & kh(i-1,j-1)+kh(i,j-1))* &
1934 ad_awrk(i,j-1,k,nold)=ad_awrk(i,j-1,k,nold)-adfac
1935 ad_awrk(i,j ,k,nold)=ad_awrk(i,j ,k,nold)+adfac
1944 adfac=pmon_r(i,j)*kh(i,j)*ad_fx(i,j)
1945 ad_awrk(i ,j,k,nold)=ad_awrk(i ,j,k,nold)-adfac
1946 ad_awrk(i+1,j,k,nold)=ad_awrk(i+1,j,k,nold)+adfac
1963 ad_a(i,j,k)=ad_a(i,j,k)+ad_awrk(i,j,k,nold)
1964 ad_awrk(i,j,k,nold)=0.0_r8
1976 & lbi, ubi, lbj, ubj, lbk, ubk, &
1986 & lbi, ubi, lbj, ubj, lbk, ubk, &
1994 & LBi, UBi, LBj, UBj, LBk, UBk, &
1995 & IminS, ImaxS, JminS, JmaxS, &
1996 & Nghost, NHsteps, NVsteps, &
1997 & DTsizeH, DTsizeV, &
2000# ifdef GEOPOTENTIAL_HCONV
2006# ifdef GEOPOTENTIAL_HCONV
2007 & pmask, rmask, umask, vmask, &
2026 integer,
intent(in) :: ng, tile, model
2027 integer,
intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
2028 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
2029 integer,
intent(in) :: Nghost, NHsteps, NVsteps
2031 real(r8),
intent(in) :: DTsizeH, DTsizeV
2033# ifdef ASSUMED_SHAPE
2034 real(r8),
intent(in) :: pm(LBi:,LBj:)
2035 real(r8),
intent(in) :: pn(LBi:,LBj:)
2036# ifdef GEOPOTENTIAL_HCONV
2037 real(r8),
intent(in) :: on_p(LBi:,LBj:)
2038 real(r8),
intent(in) :: om_r(LBi:,LBj:)
2040 real(r8),
intent(in) :: pmon_p(LBi:,LBj:)
2041 real(r8),
intent(in) :: pnom_r(LBi:,LBj:)
2044# ifdef GEOPOTENTIAL_HCONV
2045 real(r8),
intent(in) :: pmask(LBi:,LBj:)
2046 real(r8),
intent(in) :: rmask(LBi:,LBj:)
2047 real(r8),
intent(in) :: umask(LBi:,LBj:)
2048 real(r8),
intent(in) :: vmask(LBi:,LBj:)
2050 real(r8),
intent(in) :: vmask(LBi:,LBj:)
2051 real(r8),
intent(in) :: pmask(LBi:,LBj:)
2054 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
2055 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
2057 real(r8),
intent(in) :: Kh(LBi:,LBj:)
2058 real(r8),
intent(in) :: Kv(LBi:,LBj:,0:)
2060 real(r8),
intent(inout) :: ad_A(LBi:,LBj:,LBk:)
2062 real(r8),
intent(in) :: pm(LBi:UBi,LBj:UBj)
2063 real(r8),
intent(in) :: pn(LBi:UBi,LBj:UBj)
2064# ifdef GEOPOTENTIAL_HCONV
2065 real(r8),
intent(in) :: on_p(LBi:UBi,LBj:UBj)
2066 real(r8),
intent(in) :: om_r(LBi:UBi,LBj:UBj)
2068 real(r8),
intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
2069 real(r8),
intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
2072# ifdef GEOPOTENTIAL_HCONV
2073 real(r8),
intent(in) :: pmask(LBi:UBi,LBj:UBj)
2074 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
2075 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
2076 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
2078 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
2079 real(r8),
intent(in) :: pmask(LBi:UBi,LBj:UBj)
2082 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
2083 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
2085 real(r8),
intent(in) :: Kh(LBi:UBi,LBj:UBj)
2086 real(r8),
intent(in) :: Kv(LBi:UBi,LBj:UBj,0:UBk)
2088 real(r8),
intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
2093 integer :: Nnew, Nold, Nsav
2094 integer :: i, j, k, kk, kt, k1, k1b, k2, k2b, step
2096 real(r8) :: adfac, adfac1, adfac2
2097 real(r8) :: cff, cff1, cff2, cff3, cff4
2099 real(r8),
dimension(LBi:UBi,LBj:UBj,LBk:UBk,2) :: ad_Awrk
2101 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
2102 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FE
2103 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_FX
2105# ifndef SPLINES_VCONV
2106 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: FC
2108# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
2109 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: oHz
2111# if defined IMPLICIT_VCONV || defined SPLINES_VCONV
2112 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: BC
2113 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: CF
2114# ifdef SPLINES_VCONV
2115 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
2116 real(r8),
dimension(IminS:ImaxS,N(ng)) :: Hzk
2118 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: ad_DC
2120 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: ad_FS
2123# ifdef GEOPOTENTIAL_HCONV
2124 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: dZdx
2125 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: dZde
2127 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_p
2128 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_r
2129 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_FZ
2130 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAdz
2131 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAdx
2132 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,2) :: ad_dAde
2135# include "set_bounds.h"
2141 ad_awrk(lbi:ubi,lbj:ubj,lbk:ubk,1:2)=0.0_r8
2143# ifdef IMPLICIT_VCONV
2144 ad_dc(imins:imaxs,0:n(ng))=0.0_r8
2146 ad_fs(imins:imaxs,0:n(ng))=0.0_r8
2149 ad_fe(imins:imaxs,jmins:jmaxs)=0.0_r8
2150 ad_fx(imins:imaxs,jmins:jmaxs)=0.0_r8
2151# ifdef GEOPOTENTIAL_HCONV
2152 ad_fz(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
2153 ad_dadz(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
2154 ad_dadx(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
2155 ad_dade(imins:imaxs,jmins:jmaxs,1:2)=0.0_r8
2170 hfac(i,j)=cff*(pm(i,j-1)+pm(i,j))*(pn(i,j-1)+pn(i,j))
2172# ifndef SPLINES_VCONV
2173 fc(i,j,n(ng))=0.0_r8
2175# ifdef IMPLICIT_VCONV
2176 fc(i,j,k)=-dtsizev*(kv(i,j-1,k)+kv(i,j,k))/ &
2177 & (z_r(i,j-1,k+1)+z_r(i,j,k+1)- &
2178 & z_r(i,j-1,k )-z_r(i,j,k ))
2180 fc(i,j,k)=dtsizev*(kv(i,j-1,k)+kv(i,j,k))/ &
2181 & (z_r(i,j-1,k+1)+z_r(i,j,k+1)- &
2182 & z_r(i,j-1,k )-z_r(i,j,k ))
2187# if !defined IMPLICIT_VCONV || defined SPLINES_VCONV
2189 ohz(i,j,k)=2.0_r8/(hz(i,j-1,k)+hz(i,j,k))
2210 & lbi, ubi, lbj, ubj, lbk, ubk, &
2220 & lbi, ubi, lbj, ubj, lbk, ubk, &
2227 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ad_a(i,j,k)
2234# ifdef IMPLICIT_VCONV
2235# ifdef SPLINES_VCONV
2259 hzk(i,k)=0.5_r8*(hz(i,j-1,k)+ &
2266 fc(i,k)=cff1*hzk(i,k )-dtsizev*kv(i,j,k-1)*ohz(i,j,k )
2267 cf(i,k)=cff1*hzk(i,k+1)-dtsizev*kv(i,j,k+1)*ohz(i,j,k+1)
2277 bc(i,k)=cff1*(hzk(i,k)+hzk(i,k+1))+ &
2278 & dtsizev*kv(i,j,k)*(ohz(i,j,k)+ohz(i,j,k+1))
2279 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
2292 adfac=dtsizev*ohz(i,j,k)*ad_awrk(i,j,k,nnew)
2293 ad_dc(i,k-1)=ad_dc(i,k-1)-adfac
2294 ad_dc(i,k )=ad_dc(i,k )+adfac
2295 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
2296 & ad_awrk(i,j,k,nnew)
2297 ad_awrk(i,j,k,nnew)=0.0_r8
2300 ad_dc(i,k)=ad_dc(i,k)*kv(i,j,k)
2307 ad_dc(i,k+1)=ad_dc(i,k+1)-cf(i,k)*ad_dc(i,k)
2313 ad_dc(i,n(ng))=0.0_r8
2320 cff=1.0_r8/(bc(i,k)-fc(i,k)*cf(i,k-1))
2324 adfac=cff*ad_dc(i,k)
2325 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
2326 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
2327 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,k)*adfac
2357 bc(i,k)=0.5_r8*(hz(i,j-1,k)+hz(i,j,k))- &
2358 & fc(i,j,k)-fc(i,j,k-1)
2366 cf(i,1)=cff*fc(i,j,1)
2370 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
2371 cf(i,k)=cff*fc(i,j,k)
2381 ad_awrk(i,j,k,nnew)=ad_awrk(i,j,k,nnew)*vmask(i,j)
2385 ad_dc(i,k)=ad_dc(i,k)+ &
2386 & ad_awrk(i,j,k,nnew)
2387 ad_awrk(i,j,k,nnew)=0.0_r8
2390 ad_dc(i,k+1)=-cf(i,k)*ad_dc(i,k)
2397 ad_awrk(i,j,n(ng),nnew)=ad_awrk(i,j,n(ng),nnew)*vmask(i,j)
2401 ad_dc(i,n(ng))=ad_dc(i,n(ng))+ &
2402 & ad_awrk(i,j,n(ng),nnew)
2403 ad_awrk(i,j,n(ng),nnew)=0.0_r8
2408 adfac=ad_dc(i,n(ng))/ &
2409 & (bc(i,n(ng))-fc(i,j,n(ng)-1)*cf(i,n(ng)-1))
2410 ad_dc(i,n(ng)-1)=ad_dc(i,n(ng)-1)-fc(i,j,n(ng)-1)*adfac
2411 ad_dc(i,n(ng) )=adfac
2420 cff=1.0_r8/(bc(i,k)-fc(i,j,k-1)*cf(i,k-1))
2423 adfac=cff*ad_dc(i,k)
2424 ad_dc(i,k-1)=ad_dc(i,k-1)-fc(i,j,k-1)*adfac
2432 ad_dc(i,1)=cff*ad_dc(i,1)
2439 cff=0.5*(hz(i,j-1,k)+hz(i,j,k))
2442 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+cff*ad_dc(i,k)
2473 adfac=ohz(i,j,k)*ad_awrk(i,j,k,nnew)
2474 ad_fs(i,k-1)=ad_fs(i,k-1)-adfac
2475 ad_fs(i,k )=ad_fs(i,k )+adfac
2476 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
2477 & ad_awrk(i,j,k,nnew)
2478 ad_awrk(i,j,k,nnew)=0.0_r8
2488 ad_fs(i,n(ng))=0.0_r8
2498 ad_fs(i,k)=ad_fs(i,k)*vmask(i,j)
2503 adfac=fc(i,j,k)*ad_fs(i,k)
2504 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
2505 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
2536 & lbi, ubi, lbj, ubj, lbk, ubk, &
2539 & ad_awrk(:,:,:,nnew))
2546 & lbi, ubi, lbj, ubj, lbk, ubk, &
2547 & ad_awrk(:,:,:,nnew))
2549# ifdef GEOPOTENTIAL_HCONV
2578 k_loop :
DO k=n(ng),0,-1
2591 IF (kk.lt.n(ng))
THEN
2594 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
2598 dzdx(i,j)=cff*(z_r(i ,j,kk+1)- &
2604 dzdx_p(i,j,k2)=0.5_r8*(dzdx(i,j-1)+ &
2611 dzdx_p(i,j,k1b)=0.0_r8
2618 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
2622 dzde(i,j)=cff*(z_r(i,j ,k+1)- &
2628 dzde_r(i,j,k2)=0.5_r8*(dzde(i,j )+ &
2635 dzde_r(i,j,k2)=0.0_r8
2655 adfac1=hfac(i,j)*ad_awrk(i,j,k,nnew)
2656 adfac2=dtsizeh*ad_awrk(i,j,k,nnew)
2657 ad_fe(i,j-1)=ad_fe(i,j-1)-adfac1
2658 ad_fe(i,j )=ad_fe(i, j)+adfac1
2659 ad_fx(i ,j)=ad_fx(i ,j)-adfac1
2660 ad_fx(i+1,j)=ad_fx(i+1,j)+adfac1
2661 ad_fz(i,j,k1)=ad_fz(i,j,k1)-adfac2
2662 ad_fz(i,j,k2)=ad_fz(i,j,k2)+adfac2
2663 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
2664 & ad_awrk(i,j,k,nnew)
2665 ad_awrk(i,j,k,nnew)=0.0_r8
2672 IF (k.lt.n(ng))
THEN
2675 cff=0.5_r8*(kh(i,j-1)+kh(i,j))
2676 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
2677 cff2=min(dzde_r(i,j ,k2),0.0_r8)
2678 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
2679 cff4=max(dzde_r(i,j ,k1),0.0_r8)
2691 adfac=cff*ad_fz(i,j,k2)
2692 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)+ &
2697 ad_dade(i,j-1,k1)=ad_dade(i,j-1,k1)-cff1*adfac
2698 ad_dade(i,j ,k2)=ad_dade(i,j ,k2)-cff2*adfac
2699 ad_dade(i,j-1,k2)=ad_dade(i,j-1,k2)-cff3*adfac
2700 ad_dade(i,j ,k1)=ad_dade(i,j ,k1)-cff4*adfac
2702 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
2703 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
2704 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
2705 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
2716 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)+ &
2721 ad_dadx(i ,j,k1)=ad_dadx(i ,j,k1)-cff1*adfac
2722 ad_dadx(i+1,j,k2)=ad_dadx(i+1,j,k2)-cff2*adfac
2723 ad_dadx(i ,j,k2)=ad_dadx(i ,j,k2)-cff3*adfac
2724 ad_dadx(i+1,j,k1)=ad_dadx(i+1,j,k1)-cff4*adfac
2725 ad_fz(i,j,k2)=0.0_r8
2731 cff=kh(i,j)*om_r(i,j)
2732 cff1=min(dzde_r(i,j,k1),0.0_r8)
2733 cff2=max(dzde_r(i,j,k1),0.0_r8)
2742 adfac=cff*hz(i,j,k)*ad_fe(i,j)
2743 adfac1=adfac*0.5_r8*cff1
2744 adfac2=adfac*0.5_r8*cff2
2745 ad_dade(i,j,k1)=ad_dade(i,j,k1)+adfac
2746 ad_dadz(i,j ,k1)=ad_dadz(i,j ,k1)-adfac1
2747 ad_dadz(i,j+1,k2)=ad_dadz(i,j+1,k2)-adfac1
2748 ad_dadz(i,j ,k2)=ad_dadz(i,j ,k2)-adfac2
2749 ad_dadz(i,j+1,k1)=ad_dadz(i,j+1,k1)-adfac2
2755 cff=0.0625_r8*(kh(i-1,j-1)+kh(i-1,j)+ &
2756 & kh(i ,j-1)+kh(i ,j))*on_p(i,j)
2757 cff1=min(dzdx_p(i,j,k1),0.0_r8)
2758 cff2=max(dzdx_p(i,j,k1),0.0_r8)
2768 adfac=cff*(hz(i-1,j-1,k)+hz(i-1,j,k)+ &
2769 & hz(i ,j-1,k)+hz(i ,j,k))*ad_fx(i,j)
2770 adfac1=adfac*0.5_r8*cff1
2771 adfac2=adfac*0.5_r8*cff2
2772 ad_dadx(i,j,k1)=ad_dadx(i,j,k1)+adfac
2773 ad_dadz(i-1,j,k1)=ad_dadz(i-1,j,k1)-adfac1
2774 ad_dadz(i ,j,k2)=ad_dadz(i ,j,k2)-adfac1
2775 ad_dadz(i-1,j,k2)=ad_dadz(i-1,j,k2)-adfac2
2776 ad_dadz(i ,j,k1)=ad_dadz(i ,j,k1)-adfac2
2781 IF ((k.eq.0).or.(k.eq.n(ng)))
THEN
2786 ad_fz(i,j,k2)=0.0_r8
2789 ad_dadz(i,j,k2)=0.0_r8
2795 cff=1.0_r8/(z_r(i,j,k+1)-z_r(i,j,k))
2799 ad_dadz(i,j,k2)=ad_dadz(i,j,k2)*vmask(i,j)
2804 adfac=cff*ad_dadz(i,j,k2)
2805 ad_awrk(i,j,k ,nold)=ad_awrk(i,j,k ,nold)-adfac
2806 ad_awrk(i,j,k+1,nold)=ad_awrk(i,j,k+1,nold)+adfac
2807 ad_dadz(i,j,k2)=0.0_r8
2811 IF (k.lt.n(ng))
THEN
2817 ad_dade(i,j,k2)=ad_dade(i,j,k2)*rmask(i,j)
2822 adfac=pn(i,j)*ad_dade(i,j,k2)
2823 ad_awrk(i,j ,k+1,nold)=ad_awrk(i,j ,k+1,nold)- &
2825 ad_awrk(i,j+1,k+1,nold)=ad_awrk(i,j+1,k+1,nold)+ &
2826 & vmask(i,j+1)*adfac
2827 ad_dade(i,j,k2)=0.0_r8
2832 adfac=pn(i,j)*ad_dade(i,j,k2)
2833 ad_awrk(i,j ,k+1,nold)=ad_awrk(i,j ,k+1,nold)- &
2835 ad_awrk(i,j+1,k+1,nold)=ad_awrk(i,j+1,k+1,nold)+ &
2837 ad_dade(i,j,k2)=0.0_r8
2843 cff=0.25_r8*(pm(i-1,j-1)+pm(i-1,j)+ &
2844 & pm(i ,j-1)+pm(i ,j))
2848 ad_dadx(i,j,k2)=ad_dadx(i,j,k2)*pmask(i,j)
2853 adfac=cff*ad_dadx(i,j,k2)
2854 ad_awrk(i-1,j,k+1,nold)=ad_awrk(i-1,j,k+1,nold)- &
2855 & vmask(i-1,j)*adfac
2856 ad_awrk(i ,j,k+1,nold)=ad_awrk(i ,j,k+1,nold)+ &
2858 ad_dadx(i,j,k2)=0.0_r8
2863 adfac=cff*ad_dadx(i,j,k2)
2864 ad_awrk(i-1,j,k+1,nold)=ad_awrk(i-1,j,k+1,nold)- &
2866 ad_awrk(i ,j,k+1,nold)=ad_awrk(i ,j,k+1,nold)+ &
2868 ad_dadx(i,j,k2)=0.0_r8
2893 adfac=hfac(i,j)*ad_awrk(i,j,k,nnew)
2894 ad_fe(i,j-1)=ad_fe(i,j-1)-adfac
2895 ad_fe(i,j )=ad_fe(i,j )+adfac
2896 ad_fx(i ,j)=ad_fx(i ,j)-adfac
2897 ad_fx(i+1,j)=ad_fx(i+1,j)+adfac
2898 ad_awrk(i,j,k,nold)=ad_awrk(i,j,k,nold)+ &
2899 & ad_awrk(i,j,k,nnew)
2900 ad_awrk(i,j,k,nnew)=0.0_r8
2911 adfac=pnom_r(i,j)*kh(i,j)*ad_fe(i,j)
2912 ad_awrk(i,j ,k,nold)=ad_awrk(i,j ,k,nold)-adfac
2913 ad_awrk(i,j+1,k,nold)=ad_awrk(i,j+1,k,nold)+adfac
2922 ad_fx(i,j)=ad_fx(i,j)*pmask(i,j)
2928 adfac=pmon_p(i,j)*0.25_r8*(kh(i-1,j )+kh(i,j )+ &
2929 & kh(i-1,j-1)+kh(i,j-1))* &
2931 ad_awrk(i-1,j,k,nold)=ad_awrk(i-1,j,k,nold)-adfac
2932 ad_awrk(i ,j,k,nold)=ad_awrk(i ,j,k,nold)+adfac
2949 ad_a(i,j,k)=ad_a(i,j,k)+ad_awrk(i,j,k,nold)
2950 ad_awrk(i,j,k,nold)=0.0_r8
2962 & lbi, ubi, lbj, ubj, lbk, ubk, &
2972 & lbi, ubi, lbj, ubj, lbk, ubk, &