101 #include "dimensions.h"
108 #include "comconst.h"
110 #include "comgeom2.h"
111 #include "iniprint.h"
117 LOGICAL,
INTENT(IN) :: lafin
118 REAL,
INTENT(IN) :: jD_cur, jH_cur
119 REAL,
INTENT(IN) :: pvcov(iip1,jjm,
llm)
120 REAL,
INTENT(IN) :: pucov(iip1,
jjp1,
llm)
121 REAL,
INTENT(IN) :: pteta(iip1,
jjp1,
llm)
122 REAL,
INTENT(IN) :: pmasse(iip1,
jjp1,
llm)
124 REAL,
INTENT(IN) :: pphis(iip1,
jjp1)
125 REAL,
INTENT(IN) :: pphi(iip1,
jjp1,
llm)
127 REAL,
INTENT(IN) :: pdvcov(iip1,jjm,
llm)
128 REAL,
INTENT(IN) :: pducov(iip1,
jjp1,
llm)
129 REAL,
INTENT(IN) :: pdteta(iip1,
jjp1,
llm)
134 REAL,
INTENT(IN) :: pps(iip1,
jjp1)
136 REAL,
INTENT(IN) :: ppk(iip1,
jjp1,
llm)
137 REAL,
INTENT(IN) :: flxw(iip1,
jjp1,
llm)
140 REAL,
INTENT(OUT) :: pdvfi(iip1,jjm,
llm)
141 REAL,
INTENT(OUT) :: pdufi(iip1,
jjp1,
llm)
142 REAL,
INTENT(OUT) :: pdhfi(iip1,
jjp1,
llm)
144 REAL,
INTENT(OUT) :: pdpsfi(iip1,
jjp1)
152 INTEGER i,j,l,ig0,ig,iq,iiq
153 REAL,
ALLOCATABLE,
SAVE :: zpsrf(:)
154 REAL,
ALLOCATABLE,
SAVE :: zplev(:,:),zplay(:,:)
155 REAL,
ALLOCATABLE,
SAVE :: zphi(:,:),zphis(:)
157 REAL,
ALLOCATABLE,
SAVE :: zufi(:,:), zvfi(:,:)
158 REAL,
ALLOCATABLE,
SAVE :: ztfi(:,:),zqfi(:,:,:)
160 REAL,
ALLOCATABLE,
SAVE :: pcvgu(:,:), pcvgv(:,:)
161 REAL,
ALLOCATABLE,
SAVE :: pcvgt(:,:), pcvgq(:,:,:)
163 REAL,
ALLOCATABLE,
SAVE :: zdufi(:,:),zdvfi(:,:)
164 REAL,
ALLOCATABLE,
SAVE :: zdtfi(:,:),zdqfi(:,:,:)
165 REAL,
ALLOCATABLE,
SAVE :: zdpsrf(:)
166 REAL,
SAVE,
ALLOCATABLE :: flxwfi(:,:)
169 REAL,
ALLOCATABLE,
SAVE :: zplev_omp(:,:)
170 REAL,
ALLOCATABLE,
SAVE :: zplay_omp(:,:)
171 REAL,
ALLOCATABLE,
SAVE :: zphi_omp(:,:)
172 REAL,
ALLOCATABLE,
SAVE :: zphis_omp(:)
173 REAL,
ALLOCATABLE,
SAVE :: presnivs_omp(:)
174 REAL,
ALLOCATABLE,
SAVE :: zufi_omp(:,:)
175 REAL,
ALLOCATABLE,
SAVE :: zvfi_omp(:,:)
176 REAL,
ALLOCATABLE,
SAVE :: ztfi_omp(:,:)
177 REAL,
ALLOCATABLE,
SAVE :: zqfi_omp(:,:,:)
178 REAL,
ALLOCATABLE,
SAVE :: zdufi_omp(:,:)
179 REAL,
ALLOCATABLE,
SAVE :: zdvfi_omp(:,:)
180 REAL,
ALLOCATABLE,
SAVE :: zdtfi_omp(:,:)
181 REAL,
ALLOCATABLE,
SAVE :: zdqfi_omp(:,:,:)
182 REAL,
ALLOCATABLE,
SAVE :: zdpsrf_omp(:)
183 REAL,
SAVE,
ALLOCATABLE :: flxwfi_omp(:,:)
198 REAL,
ALLOCATABLE,
SAVE :: zdufic_omp(:,:)
199 REAL,
ALLOCATABLE,
SAVE :: zdvfic_omp(:,:)
200 REAL,
ALLOCATABLE,
SAVE :: zdtfic_omp(:,:)
201 REAL,
ALLOCATABLE,
SAVE :: zdqfic_omp(:,:,:)
202 REAL jH_cur_split,zdt_split
203 LOGICAL debut_split,lafin_split
213 LOGICAL,
SAVE :: first_omp=.
true.
217 REAL zsinbis(
iim),zcosbis(
iim),z1bis(
iim)
222 LOGICAL,
SAVE :: firstcal=.
true., debut=.
true.
225 REAL,
SAVE,
dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv
228 INTEGER,
dimension(MPI_STATUS_SIZE,4) :: Status
230 INTEGER,
dimension(1,4) :: Status
232 INTEGER,
dimension(4) :: Req
233 REAL,
ALLOCATABLE,
SAVE:: zdufi2(:,:),zdvfi2(:,:)
234 integer :: k,kstart,kend
250 IF (ngridmx.NE.2+(jjm-1)*
iim)
THEN
251 write(
lunout,*)
'STOP dans calfis'
253 &
'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
254 write(
lunout,*)
' ngridmx jjm iim '
259 ALLOCATE(zpsrf(
klon))
268 ALLOCATE(zdpsrf(
klon))
320 zplev( ig0,l ) = pp(i,j,l)
336 pksurcp = ppk(i,j,l) /
cpp
337 zplay(ig0,l) =
preff * pksurcp ** unskap
338 ztfi(ig0,l) = pteta(i,j,l) * pksurcp
357 zqfi(ig0,l,iq) = pq(i,j,l,iiq)
376 zphi(ig,l)=zphi(ig,l)-zphis(ig)
401 zufi(ig0,l)= 0.5 *( pucov(
iim,j,l)/
cu(
iim,j)
402 $ + pucov(1,j,l)/
cu(1,j) )
404 zufi(ig0,l)= 0.5*( pucov(i-1,j,l)/
cu(i-1,j)
405 $ + pucov(i,j,l)/
cu(i,j) )
421 zvfi(ig0,l)= 0.5 *( pvcov(i,j-1,l)/
cv(i,j-1)
422 $ + pvcov(i,j,l)/
cv(i,j) )
443 zcos(i) = cos(
rlonv(i))*z1(i)
444 zsin(i) = sin(
rlonv(i))*z1(i)
447 zufi(1,l) = ssum(
iim,zcos,1)/
pi
448 zvfi(1,l) = ssum(
iim,zsin,1)/
pi
470 zcos(i) = cos(
rlonv(i))*z1(i)
471 zsin(i) = sin(
rlonv(i))*z1(i)
492 allocate(zplev_omp(
klon,
llm+1))
495 allocate(zphis_omp(
klon))
496 allocate(presnivs_omp(
llm))
509 allocate(zdpsrf_omp(
klon))
520 zplev_omp(i,l)=zplev(offset+i,l)
526 zplay_omp(i,l)=zplay(offset+i,l)
532 zphi_omp(i,l)=zphi(offset+i,l)
537 zphis_omp(i)=zphis(offset+i)
547 zufi_omp(i,l)=zufi(offset+i,l)
553 zvfi_omp(i,l)=zvfi(offset+i,l)
559 ztfi_omp(i,l)=ztfi(offset+i,l)
566 zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq)
573 zdufi_omp(i,l)=zdufi(offset+i,l)
579 zdvfi_omp(i,l)=zdvfi(offset+i,l)
585 zdtfi_omp(i,l)=zdtfi(offset+i,l)
592 zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq)
598 zdpsrf_omp(i)=zdpsrf(offset+i)
603 flxwfi_omp(i,l)=flxwfi(offset+i,l)
622 debut_split=debut.and.isplit==1
680 zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
681 zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
682 ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
683 zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
685 zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
686 zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
687 zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
688 zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
703 zplev(offset+i,l)=zplev_omp(i,l)
709 zplay(offset+i,l)=zplay_omp(i,l)
715 zphi(offset+i,l)=zphi_omp(i,l)
721 zphis(offset+i)=zphis_omp(i)
731 zufi(offset+i,l)=zufi_omp(i,l)
737 zvfi(offset+i,l)=zvfi_omp(i,l)
743 ztfi(offset+i,l)=ztfi_omp(i,l)
750 zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq)
757 zdufi(offset+i,l)=zdufi_omp(i,l)
763 zdvfi(offset+i,l)=zdvfi_omp(i,l)
769 zdtfi(offset+i,l)=zdtfi_omp(i,l)
776 zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq)
782 zdpsrf(offset+i)=zdpsrf_omp(i)
800 du_send(1:
iim,l)=zdufi(1:
iim,l)
801 dv_send(1:
iim,l)=zdvfi(1:
iim,l)
841 call mpi_waitall(4,req(1),status,ierr)
843 call mpi_waitall(2,req(1),status,ierr)
845 call mpi_waitall(2,req(3),status,ierr)
912 pdhfi(i,j,l) =
cpp * zdtfi(ig0,l) / ppk(i,j,l)
913 if (i==1) pdhfi(iip1,j,l) =
cpp * zdtfi(ig0,l) / ppk(i,j,l)
918 pdhfi(i,1,l) =
cpp * zdtfi(1,l) / ppk(i, 1 ,l)
981 pdqfi(i,j,l,iiq) = zdqfi(ig0,l,iq)
982 if (i==1) pdqfi(iip1,j,l,iiq) = zdqfi(ig0,l,iq)
987 pdqfi(i,1,l,iiq) = zdqfi(1,l,iq)
993 pdqfi(i,
jjp1,l,iiq) = zdqfi(
klon,l,iq)
1013 pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*
cu(i,j)
1017 pdufi(
iim,j,l)=0.5*( zdufi2(ig0,l)
1019 pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*
cu(i,j)
1032 pdufi(i,
jjp1,l) = 0.
1056 pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+
iim,l))*
cv(i,j)
1057 if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+
1058 $ zdvfi2(ig0+
iim,l))
1077 $ zdufi(1,l)*cos(
rlonv(i))+zdvfi(1,l)*sin(
rlonv(i))
1080 $ 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*
cv(i,1)
1083 pdvfi(iip1,1,l) = pdvfi(1,1,l)
1096 pdvfi(i,jjm,l)=zdufi(
klon,l)*cos(
rlonv(i))
1100 $ 0.5*(pdvfi(i,jjm,l)+zdvfi(
klon-iip1+i,l))*
cv(i,jjm)
1103 pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l)
1117 &
"calfis_p: for now can only work with parallel physics"
integer, dimension(:), allocatable, save index_i
logical, save is_south_pole
integer, parameter timer_physic
subroutine calfis_p(lafin, jD_cur, jH_cur, pucov, pvcov, pteta, pq, pmasse, pps, pp, ppk, pphis, pphi, pducov, pdvcov, pdteta, pdq, flxw, pdufi, pdvfi, pdhfi, pdqfi, pdpsfi)
subroutine stop_timer(no_timer)
!$Id mode_top_bound COMMON comconstr kappa
character(len=10), save planet_type
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
integer, dimension(:), allocatable, save index_j
!$Id mode_top_bound COMMON comconstr && pi
!$Id mode_top_bound COMMON comconstr dtphys
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
subroutine gr_fi_dyn_p(nfield, ngrid, im, jm, pfi, pdyn)
subroutine physiq(nlon, nlev, debut, lafin, jD_cur, jH_cur, pdtphys, paprs, pplay, pphi, pphis, presnivs, u, v, rot, t, qx, flxmass_w, d_u, d_v, d_t, d_qx, d_ps, dudyn)
!$Id mode_top_bound COMMON comconstr cpp
integer, save klon_omp_begin
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
!$Id mode_top_bound COMMON comconstr daysec
!$Header!CDK comgeom COMMON comgeom rlonu
character(len=20), dimension(:), allocatable, save tname
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
!$Id!Parameters for parameters that control the rate of approach!to quasi equilibrium noff nlm real tlcrit real entp real sigd real coeffs real dtmax real cu real betad real damp real delta COMMON cvparam nlm tlcrit sigd coeffs cu
integer, dimension(:), allocatable, save niadv
!$Id mode_top_bound COMMON comconstr dtvr
subroutine gr_dyn_fi_p(nfield, im, jm, ngrid, pdyn, pfi)
integer, save nsplit_phys
logical, save is_north_pole
c c zjulian c cym CALL iim cym klev iim
subroutine start_timer(no_timer)
!$Header!CDK comgeom COMMON comgeom cv
INTERFACE SUBROUTINE RRTM_ECRT_140GP && pq
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
!$Header!CDK comgeom COMMON comgeom rlonv