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