Changeset 5066 for LMDZ6/trunk/libf
- Timestamp:
- Jul 18, 2024, 9:28:57 AM (4 months ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 8 edited
- 4 moved
-
dyn3dmem/leapfrog_loc.F (modified) (1 diff)
-
dyn3dmem/leapfrog_mod.F90 (modified) (1 diff)
-
dyn3dmem/lmdz_call_calfis.F90 (moved) (moved from LMDZ6/trunk/libf/dyn3dmem/call_calfis_mod.F90) (3 diffs)
-
dynphy_lonlat/lmdz_calfis_loc.F90 (moved) (moved from LMDZ6/trunk/libf/dynphy_lonlat/calfis_loc.F) (1 diff)
-
dynphy_lonlat/lmdz_gr_dyn_fi_p.F90 (moved) (moved from LMDZ6/trunk/libf/dynphy_lonlat/gr_dyn_fi_p.F) (1 diff)
-
dynphy_lonlat/lmdz_gr_fi_dyn_p.F90 (moved) (moved from LMDZ6/trunk/libf/dynphy_lonlat/gr_fi_dyn_p.F) (1 diff)
-
misc/lmdz_xios.F90 (modified) (1 diff)
-
obsolete/wstats.F90 (modified) (1 diff)
-
phylmd/phys_local_var_mod.F90 (modified) (1 diff)
-
phylmd/physiq_mod.F90 (modified) (1 diff)
-
phylmdiso/phys_local_var_mod.F90 (modified) (1 diff)
-
phylmdiso/physiq_mod.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F
r4619 r5066 28 28 USE allocate_field_mod 29 29 USE call_dissip_mod, ONLY : call_dissip 30 USE call_calfis_mod, ONLY : call_calfis30 USE lmdz_call_calfis, ONLY : call_calfis 31 31 USE leapfrog_mod, ONLY : ucov,vcov,teta,ps,masse,phis,q,dq 32 32 & ,ucovm1,vcovm1,tetam1,massem1,psm1,p,pks,pk,pkf,flxw -
LMDZ6/trunk/libf/dyn3dmem/leapfrog_mod.F90
r2021 r5066 44 44 USE integrd_mod,ONLY : integrd_allocate 45 45 USE caladvtrac_mod,ONLY : caladvtrac_allocate 46 USE call_calfis_mod,ONLY : call_calfis_allocate46 USE lmdz_call_calfis,ONLY : call_calfis_allocate 47 47 USE call_dissip_mod, ONLY : call_dissip_allocate 48 48 IMPLICIT NONE -
LMDZ6/trunk/libf/dyn3dmem/lmdz_call_calfis.F90
r5065 r5066 1 1 !#define DEBUG_IO 2 MODULE call_calfis_mod2 MODULE lmdz_call_calfis 3 3 4 4 REAL,POINTER,SAVE :: ucov(:,:) … … 88 88 USE comvert_mod, ONLY: ap, bp, pressure_exner 89 89 USE temps_mod, ONLY: day_ini, day_ref, jd_ref, jh_ref, start_time 90 90 #ifdef CPP_PHYS 91 USE lmdz_calfis_loc 92 #endif 93 91 94 IMPLICIT NONE 92 95 INCLUDE "iniprint.h" … … 414 417 END SUBROUTINE call_calfis 415 418 416 END MODULE call_calfis_mod419 END MODULE lmdz_call_calfis -
LMDZ6/trunk/libf/dynphy_lonlat/lmdz_calfis_loc.F90
r5065 r5066 1 ! 2 ! $Id$ 3 ! 4 C 5 C 6 SUBROUTINE calfis_loc(lafin, 7 $ jD_cur, jH_cur, 8 $ pucov, 9 $ pvcov, 10 $ pteta, 11 $ pq, 12 $ pmasse, 13 $ pps, 14 $ pp, 15 $ ppk, 16 $ pphis, 17 $ pphi, 18 $ pducov, 19 $ pdvcov, 20 $ pdteta, 21 $ pdq, 22 $ flxw, 23 $ pdufi, 24 $ pdvfi, 25 $ pdhfi, 26 $ pdqfi, 27 $ pdpsfi) 1 #ifdef CPP_PARA 2 MODULE lmdz_calfis_loc 3 IMPLICIT NONE 4 PRIVATE 5 PUBLIC calfis_loc 6 CONTAINS 7 8 SUBROUTINE calfis_loc(lafin, & 9 jD_cur, jH_cur, & 10 pucov, & 11 pvcov, & 12 pteta, & 13 pq, & 14 pmasse, & 15 pps, & 16 pp, & 17 ppk, & 18 pphis, & 19 pphi, & 20 pducov, & 21 pdvcov, & 22 pdteta, & 23 pdq, & 24 flxw, & 25 pdufi, & 26 pdvfi, & 27 pdhfi, & 28 pdqfi, & 29 pdpsfi) 28 30 #ifdef CPP_PHYS 29 ! If using physics30 c 31 c Auteur : P. Le Van, F. Hourdin 32 c.........33 34 35 36 37 38 31 ! If using physics 32 ! 33 ! Auteur : P. Le Van, F. Hourdin 34 ! ......... 35 USE dimphy 36 USE mod_phys_lmdz_mpi_data, mpi_root_xx=>mpi_master 37 USE mod_phys_lmdz_omp_data, ONLY: klon_omp, klon_omp_begin 38 USE mod_const_mpi, ONLY: COMM_LMDZ 39 USE mod_interface_dyn_phys 40 USE IOPHY 39 41 #endif 40 USE lmdz_mpi 41 42 #ifdef CPP_PARA 43 USE parallel_lmdz,ONLY:omp_chunk,using_mpi,jjb_u,jje_u,jjb_v,jje_v 44 $ ,jj_begin_dyn=>jj_begin,jj_end_dyn=>jj_end 45 USE Write_Field 46 Use Write_field_p 47 USE Times 42 USE lmdz_mpi 43 44 USE parallel_lmdz,ONLY:omp_chunk,using_mpi,jjb_u,jje_u,jjb_v,jje_v & 45 ,jj_begin_dyn=>jj_begin,jj_end_dyn=>jj_end 46 USE Write_Field 47 Use Write_field_p 48 USE Times 49 USE infotrac, ONLY : nqtot, tracers 50 USE control_mod, ONLY : planet_type, nsplit_phys 51 #ifdef CPP_PHYS 52 USE callphysiq_mod, ONLY: call_physiq 48 53 #endif 49 USE infotrac, ONLY: nqtot, tracers 50 USE control_mod, ONLY: planet_type, nsplit_phys 54 USE comvert_mod, ONLY : preff, presnivs 55 USE comconst_mod, ONLY : cpp, daysec, dtphys, dtvr, kappa, pi 56 57 !======================================================================= 58 ! 59 ! 1. rearrangement des tableaux et transformation 60 ! variables dynamiques > variables physiques 61 ! 2. calcul des termes physiques 62 ! 3. retransformation des tendances physiques en tendances dynamiques 63 ! 64 ! remarques: 65 ! ---------- 66 ! 67 ! - les vents sont donnes dans la physique par leurs composantes 68 ! naturelles. 69 ! - la variable thermodynamique de la physique est une variable 70 ! intensive : T 71 ! pour la dynamique on prend T * ( preff / p(l) ) **kappa 72 ! - les deux seules variables dependant de la geometrie necessaires 73 ! pour la physique sont la latitude pour le rayonnement et 74 ! l'aire de la maille quand on veut integrer une grandeur 75 ! horizontalement. 76 ! - les points de la physique sont les points scalaires de la 77 ! la dynamique; numerotation: 78 ! 1 pour le pole nord 79 ! (jjm-1)*iim pour l'interieur du domaine 80 ! ngridmx pour le pole sud 81 ! ---> ngridmx=2+(jjm-1)*iim 82 ! 83 ! Input : 84 ! ------- 85 ! ecritphy frequence d'ecriture (en jours)de histphy 86 ! pucov covariant zonal velocity 87 ! pvcov covariant meridional velocity 88 ! pteta potential temperature 89 ! pps surface pressure 90 ! pmasse masse d'air dans chaque maille 91 ! pts surface temperature (K) 92 ! callrad clef d'appel au rayonnement 93 ! 94 ! Output : 95 ! -------- 96 ! pdufi tendency for the natural zonal velocity (ms-1) 97 ! pdvfi tendency for the natural meridional velocity 98 ! pdhfi tendency for the potential temperature 99 ! pdtsfi tendency for the surface temperature 100 ! 101 ! pdtrad radiative tendencies \ both input 102 ! pfluxrad radiative fluxes / and output 103 ! 104 !======================================================================= 105 ! 106 !----------------------------------------------------------------------- 107 ! 108 ! 0. Declarations : 109 ! ------------------ 110 111 include "dimensions.h" 112 include "paramet.h" 113 114 INTEGER :: ngridmx 115 PARAMETER(ngridmx = 2 + (jjm - 1) * iim - 1 / jjm) 116 117 include "comgeom2.h" 118 include "iniprint.h" 119 ! Arguments : 120 ! ----------- 121 LOGICAL, INTENT(IN) :: lafin ! .true. for the very last call to physics 122 REAL, INTENT(IN) :: jD_cur, jH_cur 123 REAL, INTENT(IN) :: pvcov(iip1, jjb_v:jje_v, llm) ! covariant meridional velocity 124 REAL, INTENT(IN) :: pucov(iip1, jjb_u:jje_u, llm) ! covariant zonal velocity 125 REAL, INTENT(IN) :: pteta(iip1, jjb_u:jje_u, llm) ! potential temperature 126 REAL, INTENT(IN) :: pmasse(iip1, jjb_u:jje_u, llm) ! mass in each cell ! not used 127 REAL, INTENT(IN) :: pq(iip1, jjb_u:jje_u, llm, nqtot) ! tracers 128 REAL, INTENT(IN) :: pphis(iip1, jjb_u:jje_u) ! surface geopotential 129 REAL, INTENT(IN) :: pphi(iip1, jjb_u:jje_u, llm) ! geopotential 130 131 REAL, INTENT(IN) :: pdvcov(iip1, jjb_v:jje_v, llm) ! dynamical tendency on vcov ! not used 132 REAL, INTENT(IN) :: pducov(iip1, jjb_u:jje_u, llm) ! dynamical tendency on ucov 133 REAL, INTENT(IN) :: pdteta(iip1, jjb_u:jje_u, llm) ! dynamical tendency on teta ! not used 134 REAL, INTENT(IN) :: pdq(iip1, jjb_u:jje_u, llm, nqtot) ! dynamical tendency on tracers ! not used 135 136 REAL, INTENT(IN) :: pps(iip1, jjb_u:jje_u) ! surface pressure (Pa) 137 REAL, INTENT(IN) :: pp(iip1, jjb_u:jje_u, llmp1) ! pressure at mesh interfaces (Pa) 138 REAL, INTENT(IN) :: ppk(iip1, jjb_u:jje_u, llm) ! Exner at mid-layer 139 REAL, INTENT(IN) :: flxw(iip1, jjb_u:jje_u, llm) ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0) 140 141 ! ! tendencies (in */s) from the physics 142 REAL, INTENT(OUT) :: pdvfi(iip1, jjb_v:jje_v, llm) ! tendency on covariant meridional wind 143 REAL, INTENT(OUT) :: pdufi(iip1, jjb_u:jje_u, llm) ! tendency on covariant zonal wind 144 REAL, INTENT(OUT) :: pdhfi(iip1, jjb_u:jje_u, llm) ! tendency on potential temperature (K/s) 145 REAL, INTENT(OUT) :: pdqfi(iip1, jjb_u:jje_u, llm, nqtot) ! tendency on tracers 146 REAL, INTENT(OUT) :: pdpsfi(iip1, jjb_u:jje_u) ! tendency on surface pressure (Pa/s) 147 51 148 #ifdef CPP_PHYS 52 USE callphysiq_mod, ONLY: call_physiq 53 #endif 54 USE comvert_mod, ONLY: preff, presnivs 55 USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, kappa, pi 56 57 #ifdef CPP_PARA 58 IMPLICIT NONE 59 c======================================================================= 60 c 61 c 1. rearrangement des tableaux et transformation 62 c variables dynamiques > variables physiques 63 c 2. calcul des termes physiques 64 c 3. retransformation des tendances physiques en tendances dynamiques 65 c 66 c remarques: 67 c ---------- 68 c 69 c - les vents sont donnes dans la physique par leurs composantes 70 c naturelles. 71 c - la variable thermodynamique de la physique est une variable 72 c intensive : T 73 c pour la dynamique on prend T * ( preff / p(l) ) **kappa 74 c - les deux seules variables dependant de la geometrie necessaires 75 c pour la physique sont la latitude pour le rayonnement et 76 c l'aire de la maille quand on veut integrer une grandeur 77 c horizontalement. 78 c - les points de la physique sont les points scalaires de la 79 c la dynamique; numerotation: 80 c 1 pour le pole nord 81 c (jjm-1)*iim pour l'interieur du domaine 82 c ngridmx pour le pole sud 83 c ---> ngridmx=2+(jjm-1)*iim 84 c 85 c Input : 86 c ------- 87 c ecritphy frequence d'ecriture (en jours)de histphy 88 c pucov covariant zonal velocity 89 c pvcov covariant meridional velocity 90 c pteta potential temperature 91 c pps surface pressure 92 c pmasse masse d'air dans chaque maille 93 c pts surface temperature (K) 94 c callrad clef d'appel au rayonnement 95 c 96 c Output : 97 c -------- 98 c pdufi tendency for the natural zonal velocity (ms-1) 99 c pdvfi tendency for the natural meridional velocity 100 c pdhfi tendency for the potential temperature 101 c pdtsfi tendency for the surface temperature 102 c 103 c pdtrad radiative tendencies \ both input 104 c pfluxrad radiative fluxes / and output 105 c 106 c======================================================================= 107 c 108 c----------------------------------------------------------------------- 109 c 110 c 0. Declarations : 111 c ------------------ 112 113 include "dimensions.h" 114 include "paramet.h" 115 116 INTEGER ngridmx 117 PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm ) 118 119 include "comgeom2.h" 120 include "iniprint.h" 121 c Arguments : 122 c ----------- 123 LOGICAL,INTENT(IN) :: lafin ! .true. for the very last call to physics 124 REAL,INTENT(IN):: jD_cur, jH_cur 125 REAL,INTENT(IN):: pvcov(iip1,jjb_v:jje_v,llm) ! covariant meridional velocity 126 REAL,INTENT(IN):: pucov(iip1,jjb_u:jje_u,llm) ! covariant zonal velocity 127 REAL,INTENT(IN):: pteta(iip1,jjb_u:jje_u,llm) ! potential temperature 128 REAL,INTENT(IN):: pmasse(iip1,jjb_u:jje_u,llm) ! mass in each cell ! not used 129 REAL,INTENT(IN):: pq(iip1,jjb_u:jje_u,llm,nqtot) ! tracers 130 REAL,INTENT(IN):: pphis(iip1,jjb_u:jje_u) ! surface geopotential 131 REAL,INTENT(IN):: pphi(iip1,jjb_u:jje_u,llm) ! geopotential 132 133 REAL,INTENT(IN) :: pdvcov(iip1,jjb_v:jje_v,llm) ! dynamical tendency on vcov ! not used 134 REAL,INTENT(IN) :: pducov(iip1,jjb_u:jje_u,llm) ! dynamical tendency on ucov 135 REAL,INTENT(IN) :: pdteta(iip1,jjb_u:jje_u,llm) ! dynamical tendency on teta ! not used 136 REAL,INTENT(IN) :: pdq(iip1,jjb_u:jje_u,llm,nqtot) ! dynamical tendency on tracers ! not used 137 138 REAL,INTENT(IN) :: pps(iip1,jjb_u:jje_u) ! surface pressure (Pa) 139 REAL,INTENT(IN) :: pp(iip1,jjb_u:jje_u,llmp1) ! pressure at mesh interfaces (Pa) 140 REAL,INTENT(IN) :: ppk(iip1,jjb_u:jje_u,llm) ! Exner at mid-layer 141 REAL,INTENT(IN) :: flxw(iip1,jjb_u:jje_u,llm) ! Vertical mass flux on lower mesh interfaces (kg/s) (on llm because flxw(:,:,llm+1)=0) 142 143 ! tendencies (in */s) from the physics 144 REAL,INTENT(OUT) :: pdvfi(iip1,jjb_v:jje_v,llm) ! tendency on covariant meridional wind 145 REAL,INTENT(OUT) :: pdufi(iip1,jjb_u:jje_u,llm) ! tendency on covariant zonal wind 146 REAL,INTENT(OUT) :: pdhfi(iip1,jjb_u:jje_u,llm) ! tendency on potential temperature (K/s) 147 REAL,INTENT(OUT) :: pdqfi(iip1,jjb_u:jje_u,llm,nqtot) ! tendency on tracers 148 REAL,INTENT(OUT) :: pdpsfi(iip1,jjb_u:jje_u) ! tendency on surface pressure (Pa/s) 149 ! Ehouarn: for now calfis_p needs some informations from physics to compile 150 ! Local variables : 151 ! ----------------- 152 153 INTEGER :: i,j,l,ig0,ig,iq,itr 154 REAL,ALLOCATABLE,SAVE :: zpsrf(:) 155 REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:) 156 REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:) 157 ! 158 REAL :: zrot(iip1,jjb_v:jje_v,llm) ! AdlC May 2014 159 REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:), zrfi(:,:) 160 REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:) 161 REAL,ALLOCATABLE,SAVE :: zpk(:,:) 162 ! 163 REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:) 164 REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:) 165 ! 166 REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:) 167 REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:) 168 REAL,ALLOCATABLE,SAVE :: zdpsrf(:) 169 REAL,SAVE,ALLOCATABLE :: flxwfi(:,:) ! Flux de masse verticale sur la grille physiq 170 171 ! 172 REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:) 173 REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:) 174 REAL,ALLOCATABLE,SAVE :: zpk_omp(:,:) 175 REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:) 176 REAL,ALLOCATABLE,SAVE :: zphis_omp(:) 177 REAL,ALLOCATABLE,SAVE :: presnivs_omp(:) 178 REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 179 REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:) 180 REAL,ALLOCATABLE,SAVE :: zrfi_omp(:,:) 181 REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:) 182 REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:) 183 REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:) 184 REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:) 185 REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:) 186 REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:) 187 REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:) 188 REAL,SAVE,ALLOCATABLE :: flxwfi_omp(:,:) ! Flux de masse verticale sur la grille physiq 189 190 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 191 ! Introduction du splitting (FH) 192 ! Question pour Yann : 193 ! J'ai �t� surpris au d�but que les tableaux zufi_omp, zdufi_omp n'co soitent 194 ! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il 195 ! soit allocatable (plutot par exemple que de passer une dimension 196 ! d�pendant du process en argument des routines) et que, du coup, 197 ! le SAVE �vite d'avoir � refaire l'allocation � chaque appel. 198 ! Tu confirmes ? 199 ! J'ai suivi le m�me principe pour les zdufic_omp 200 ! Mais c'est surement bien que tu controles. 201 ! 202 203 REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:) 204 REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:) 205 REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:) 206 REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:) 207 REAL :: jH_cur_split,zdt_split 208 LOGICAL :: debut_split,lafin_split 209 INTEGER :: isplit 210 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 211 212 !$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp, & 213 !$OMP presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, & 214 !$OMP zrfi_omp,zqfi_omp,zdufi_omp,zdvfi_omp, & 215 !$OMP zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp, & 216 !$OMP zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp) 217 218 LOGICAL,SAVE :: first_omp=.true. 219 !$OMP THREADPRIVATE(first_omp) 220 221 REAL :: zsin(iim),zcos(iim),z1(iim) 222 REAL :: zsinbis(iim),zcosbis(iim),z1bis(iim) 223 REAL :: unskap, pksurcp 224 ! 225 REAL :: SSUM 226 227 LOGICAL,SAVE :: firstcal=.true., debut=.true. 228 !$OMP THREADPRIVATE(firstcal,debut) 229 230 REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv 231 INTEGER :: ierr 232 INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status 233 INTEGER, dimension(4) :: Req 234 REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:) 235 integer :: k,kstart,kend 236 INTEGER :: offset 237 INTEGER :: jjb,jje 238 239 ! 240 !----------------------------------------------------------------------- 241 ! 242 ! 1. Initialisations : 243 ! -------------------- 244 ! 245 246 klon=klon_mpi 247 248 ! 249 IF ( firstcal ) THEN 250 debut = .TRUE. 251 IF (ngridmx.NE.2+(jjm-1)*iim) THEN 252 write(lunout,*) 'STOP dans calfis' 253 write(lunout,*) & 254 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 255 write(lunout,*) ' ngridmx jjm iim ' 256 write(lunout,*) ngridmx,jjm,iim 257 call abort_gcm("calfis_loc", "", 1) 258 ENDIF 259 !$OMP MASTER 260 ALLOCATE(zpsrf(klon)) 261 ALLOCATE(zplev(klon,llm+1),zplay(klon,llm)) 262 ALLOCATE(zphi(klon,llm),zphis(klon)) 263 ALLOCATE(zufi(klon,llm), zvfi(klon,llm),zrfi(klon,llm)) 264 ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot)) 265 ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm)) 266 ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2)) 267 ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm)) 268 ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot)) 269 ALLOCATE(zdpsrf(klon)) 270 ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm)) 271 ALLOCATE(flxwfi(klon,llm)) 272 ALLOCATE(zpk(klon,llm)) 273 !$OMP END MASTER 274 !$OMP BARRIER 275 ELSE 276 debut = .FALSE. 277 ENDIF 278 279 ! 280 ! 281 !----------------------------------------------------------------------- 282 ! 40. transformation des variables dynamiques en variables physiques: 283 ! --------------------------------------------------------------- 284 285 ! 41. pressions au sol (en Pascals) 286 ! ---------------------------------- 287 288 !$OMP MASTER 289 call start_timer(timer_physic) 290 !$OMP END MASTER 291 292 !$OMP MASTER 293 !CDIR ON_ADB(index_i) 294 !CDIR ON_ADB(index_j) 295 do ig0=1,klon 296 i=index_i(ig0) 297 j=index_j(ig0) 298 zpsrf(ig0)=pps(i,j) 299 enddo 300 !$OMP END MASTER 301 302 303 ! 42. pression intercouches : 304 ! 305 ! ----------------------------------------------------------------- 306 ! .... zplev definis aux (llm +1) interfaces des couches .... 307 ! .... zplay definis aux ( llm ) milieux des couches .... 308 ! ----------------------------------------------------------------- 309 310 ! ... Exner = cp * ( p(l) / preff ) ** kappa .... 311 ! 312 unskap = 1./ kappa 313 ! 314 ! print *,omp_rank,'klon--->',klon 315 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 316 DO l = 1, llmp1 317 !CDIR ON_ADB(index_i) 318 !CDIR ON_ADB(index_j) 319 do ig0=1,klon 320 i=index_i(ig0) 321 j=index_j(ig0) 322 zplev( ig0,l ) = pp(i,j,l) 323 enddo 324 ENDDO 325 !$OMP END DO NOWAIT 326 327 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 328 DO l=1,llm 329 do ig0=1,klon 330 i=index_i(ig0) 331 j=index_j(ig0) 332 zpk(ig0,l)=ppk(i,j,l) 333 enddo 334 ENDDO 335 !$OMP END DO NOWAIT 336 337 ! 338 ! 339 340 ! 43. temperature naturelle (en K) et pressions milieux couches . 341 ! --------------------------------------------------------------- 342 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 343 DO l=1,llm 344 !CDIR ON_ADB(index_i) 345 !CDIR ON_ADB(index_j) 346 do ig0=1,klon 347 i=index_i(ig0) 348 j=index_j(ig0) 349 pksurcp = ppk(i,j,l) / cpp 350 zplay(ig0,l) = preff * pksurcp ** unskap 351 ztfi(ig0,l) = pteta(i,j,l) * pksurcp 352 enddo 353 354 ENDDO 355 !$OMP END DO NOWAIT 356 357 ! 43.bis traceurs 358 ! --------------- 359 ! 360 361 itr = 0 362 DO iq=1,nqtot 363 IF(.NOT.tracers(iq)%isAdvected) CYCLE 364 itr = itr + 1 365 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 366 DO l=1,llm 367 !CDIR ON_ADB(index_i) 368 !CDIR ON_ADB(index_j) 369 do ig0=1,klon 370 i=index_i(ig0) 371 j=index_j(ig0) 372 zqfi(ig0,l,itr) = pq(i,j,l,iq) 373 enddo 374 ENDDO 375 !$OMP END DO NOWAIT 376 ENDDO 377 378 379 ! Geopotentiel calcule par rapport a la surface locale: 380 ! ----------------------------------------------------- 381 382 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 383 DO l=1,llm 384 !CDIR ON_ADB(index_i) 385 !CDIR ON_ADB(index_j) 386 do ig0=1,klon 387 i=index_i(ig0) 388 j=index_j(ig0) 389 zphi(ig0,l) = pphi(i,j,l) 390 enddo 391 ENDDO 392 !$OMP END DO NOWAIT 393 394 ! CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi) 395 396 !$OMP MASTER 397 !CDIR ON_ADB(index_i) 398 !CDIR ON_ADB(index_j) 399 do ig0=1,klon 400 i=index_i(ig0) 401 j=index_j(ig0) 402 zphis(ig0) = pphis(i,j) 403 enddo 404 !$OMP END MASTER 405 406 407 ! CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis) 408 409 !$OMP BARRIER 410 411 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 412 DO l=1,llm 413 DO ig=1,klon 414 zphi(ig,l)=zphi(ig,l)-zphis(ig) 415 ENDDO 416 ENDDO 417 !$OMP END DO NOWAIT 418 419 420 ! 421 ! 45. champ u: 422 ! ------------ 423 424 kstart=1 425 kend=klon 426 427 if (is_north_pole_dyn) kstart=2 428 if (is_south_pole_dyn) kend=klon-1 429 430 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 431 DO l=1,llm 432 !CDIR ON_ADB(index_i) 433 !CDIR ON_ADB(index_j) 434 !CDIR SPARSE 435 do ig0=kstart,kend 436 i=index_i(ig0) 437 j=index_j(ig0) 438 if (i==1) then 439 zufi(ig0,l)= 0.5 *( pucov(iim,j,l)/cu(iim,j) & 440 + pucov(1,j,l)/cu(1,j) ) 441 else 442 zufi(ig0,l)= 0.5*( pucov(i-1,j,l)/cu(i-1,j) & 443 + pucov(i,j,l)/cu(i,j) ) 444 endif 445 enddo 446 ENDDO 447 !$OMP END DO NOWAIT 448 449 ! 450 ! Alvaro de la Camara (May 2014) 451 ! 46.1 Calcul de la vorticite et passage sur la grille physique 452 ! -------------------------------------------------------------- 453 454 jjb=jj_begin_dyn-1 455 jje=jj_end_dyn+1 456 if (is_north_pole_dyn) jjb=1 457 if (is_south_pole_dyn) jje=jjm 458 459 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 460 461 DO l=1,llm 462 do i=1,iim 463 do j=jjb,jje 464 zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l) & 465 + pucov(i,j+1,l) - pucov(i,j,l)) & 466 / (cu(i,j)+cu(i,j+1)) & 467 / (cv(i+1,j)+cv(i,j)) *4 468 enddo 469 enddo 470 ENDDO 471 472 473 ! 46.2champ v: 474 ! ----------- 475 476 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 477 DO l=1,llm 478 !CDIR ON_ADB(index_i) 479 !CDIR ON_ADB(index_j) 480 DO ig0=kstart,kend 481 i=index_i(ig0) 482 j=index_j(ig0) 483 zvfi(ig0,l)= 0.5 *( pvcov(i,j-1,l)/cv(i,j-1) & 484 + pvcov(i,j,l)/cv(i,j) ) 485 if (j==1 .OR. j==jjp1) then ! AdlC MAY 2014 486 zrfi(ig0,l) = 0 ! AdlC MAY 2014 487 else 488 if(i==1)then 489 zrfi(ig0,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l) & 490 +zrot(1,j-1,l)+zrot(1,j,l)) ! AdlC MAY 2014 491 else 492 zrfi(ig0,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l) & 493 +zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014 494 endif 495 endif 496 497 498 ENDDO 499 ENDDO 500 !$OMP END DO NOWAIT 501 502 ! 47. champs de vents aux pole nord 503 ! ------------------------------ 504 ! U = 1 / pi * integrale [ v * cos(long) * d long ] 505 ! V = 1 / pi * integrale [ v * sin(long) * d long ] 506 507 if (is_north_pole_dyn) then 508 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 509 DO l=1,llm 510 511 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1) 512 DO i=2,iim 513 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1) 514 ENDDO 515 516 DO i=1,iim 517 zcos(i) = COS(rlonv(i))*z1(i) 518 zsin(i) = SIN(rlonv(i))*z1(i) 519 ENDDO 520 521 zufi(1,l) = SSUM(iim,zcos,1)/pi 522 zvfi(1,l) = SSUM(iim,zsin,1)/pi 523 zrfi(1,l) = 0. 524 525 ENDDO 526 !$OMP END DO NOWAIT 527 endif 528 529 530 ! 48. champs de vents aux pole sud: 531 ! --------------------------------- 532 ! U = 1 / pi * integrale [ v * cos(long) * d long ] 533 ! V = 1 / pi * integrale [ v * sin(long) * d long ] 534 535 if (is_south_pole_dyn) then 536 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 537 DO l=1,llm 538 539 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm) 540 DO i=2,iim 541 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm) 542 ENDDO 543 544 DO i=1,iim 545 zcos(i) = COS(rlonv(i))*z1(i) 546 zsin(i) = SIN(rlonv(i))*z1(i) 547 ENDDO 548 549 zufi(klon,l) = SSUM(iim,zcos,1)/pi 550 zvfi(klon,l) = SSUM(iim,zsin,1)/pi 551 zrfi(klon,l) = 0. 552 ENDDO 553 !$OMP END DO NOWAIT 554 endif 555 556 ! On change de grille, dynamique vers physiq, pour le flux de masse verticale 557 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 558 DO l=1,llm 559 !CDIR ON_ADB(index_i) 560 !CDIR ON_ADB(index_j) 561 do ig0=1,klon 562 i=index_i(ig0) 563 j=index_j(ig0) 564 flxwfi(ig0,l) = flxw(i,j,l) 565 enddo 566 ENDDO 567 !$OMP END DO NOWAIT 568 569 ! CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi) 570 571 !----------------------------------------------------------------------- 572 ! Appel de la physique: 573 ! --------------------- 574 575 576 !$OMP BARRIER 577 if (first_omp) then 578 klon=klon_omp 579 580 allocate(zplev_omp(klon,llm+1)) 581 allocate(zplay_omp(klon,llm)) 582 allocate(zpk_omp(klon,llm)) 583 allocate(zphi_omp(klon,llm)) 584 allocate(zphis_omp(klon)) 585 allocate(presnivs_omp(llm)) 586 allocate(zufi_omp(klon,llm)) 587 allocate(zvfi_omp(klon,llm)) 588 allocate(zrfi_omp(klon,llm)) ! LG Ari 2014 589 allocate(ztfi_omp(klon,llm)) 590 allocate(zqfi_omp(klon,llm,nqtot)) 591 allocate(zdufi_omp(klon,llm)) 592 allocate(zdvfi_omp(klon,llm)) 593 allocate(zdtfi_omp(klon,llm)) 594 allocate(zdqfi_omp(klon,llm,nqtot)) 595 allocate(zdufic_omp(klon,llm)) 596 allocate(zdvfic_omp(klon,llm)) 597 allocate(zdtfic_omp(klon,llm)) 598 allocate(zdqfic_omp(klon,llm,nqtot)) 599 allocate(zdpsrf_omp(klon)) 600 allocate(flxwfi_omp(klon,llm)) 601 first_omp=.false. 602 endif 603 604 605 klon=klon_omp 606 offset=klon_omp_begin-1 607 608 do l=1,llm+1 609 do i=1,klon 610 zplev_omp(i,l)=zplev(offset+i,l) 611 enddo 612 enddo 613 614 do l=1,llm 615 do i=1,klon 616 zplay_omp(i,l)=zplay(offset+i,l) 617 enddo 618 enddo 619 620 do l=1,llm 621 do i=1,klon 622 zpk_omp(i,l)=zpk(offset+i,l) 623 enddo 624 enddo 625 626 do l=1,llm 627 do i=1,klon 628 zphi_omp(i,l)=zphi(offset+i,l) 629 enddo 630 enddo 631 632 do i=1,klon 633 zphis_omp(i)=zphis(offset+i) 634 enddo 635 636 637 do l=1,llm 638 presnivs_omp(l)=presnivs(l) 639 enddo 640 641 do l=1,llm 642 do i=1,klon 643 zufi_omp(i,l)=zufi(offset+i,l) 644 enddo 645 enddo 646 647 do l=1,llm 648 do i=1,klon 649 zvfi_omp(i,l)=zvfi(offset+i,l) 650 enddo 651 enddo 652 653 do l=1,llm 654 do i=1,klon 655 zrfi_omp(i,l)=zrfi(offset+i,l) 656 enddo 657 enddo 658 659 do l=1,llm 660 do i=1,klon 661 ztfi_omp(i,l)=ztfi(offset+i,l) 662 enddo 663 enddo 664 665 do iq=1,nqtot 666 do l=1,llm 667 do i=1,klon 668 zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq) 669 enddo 670 enddo 671 enddo 672 673 do l=1,llm 674 do i=1,klon 675 zdufi_omp(i,l)=zdufi(offset+i,l) 676 enddo 677 enddo 678 679 do l=1,llm 680 do i=1,klon 681 zdvfi_omp(i,l)=zdvfi(offset+i,l) 682 enddo 683 enddo 684 685 do l=1,llm 686 do i=1,klon 687 zdtfi_omp(i,l)=zdtfi(offset+i,l) 688 enddo 689 enddo 690 691 do iq=1,nqtot 692 do l=1,llm 693 do i=1,klon 694 zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq) 695 enddo 696 enddo 697 enddo 698 699 do i=1,klon 700 zdpsrf_omp(i)=zdpsrf(offset+i) 701 enddo 702 703 do l=1,llm 704 do i=1,klon 705 flxwfi_omp(i,l)=flxwfi(offset+i,l) 706 enddo 707 enddo 708 709 !$OMP BARRIER 710 711 712 !$OMP MASTER 713 ! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 714 !$OMP END MASTER 715 zdt_split=dtphys/nsplit_phys 716 zdufic_omp(:,:)=0. 717 zdvfic_omp(:,:)=0. 718 zdtfic_omp(:,:)=0. 719 zdqfic_omp(:,:,:)=0. 149 720 150 721 #ifdef CPP_PHYS 151 ! Ehouarn: for now calfis_p needs some informations from physics to compile 152 c Local variables : 153 c ----------------- 154 155 INTEGER i,j,l,ig0,ig,iq,itr 156 REAL,ALLOCATABLE,SAVE :: zpsrf(:) 157 REAL,ALLOCATABLE,SAVE :: zplev(:,:),zplay(:,:) 158 REAL,ALLOCATABLE,SAVE :: zphi(:,:),zphis(:) 159 c 160 REAL zrot(iip1,jjb_v:jje_v,llm) ! AdlC May 2014 161 REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:), zrfi(:,:) 162 REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:) 163 REAL,ALLOCATABLE,SAVE :: zpk(:,:) 164 c 165 REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:) 166 REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:) 167 c 168 REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:) 169 REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:) 170 REAL,ALLOCATABLE,SAVE :: zdpsrf(:) 171 REAL,SAVE,ALLOCATABLE :: flxwfi(:,:) ! Flux de masse verticale sur la grille physiq 172 173 c 174 REAL,ALLOCATABLE,SAVE :: zplev_omp(:,:) 175 REAL,ALLOCATABLE,SAVE :: zplay_omp(:,:) 176 REAL,ALLOCATABLE,SAVE :: zpk_omp(:,:) 177 REAL,ALLOCATABLE,SAVE :: zphi_omp(:,:) 178 REAL,ALLOCATABLE,SAVE :: zphis_omp(:) 179 REAL,ALLOCATABLE,SAVE :: presnivs_omp(:) 180 REAL,ALLOCATABLE,SAVE :: zufi_omp(:,:) 181 REAL,ALLOCATABLE,SAVE :: zvfi_omp(:,:) 182 REAL,ALLOCATABLE,SAVE :: zrfi_omp(:,:) 183 REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:) 184 REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:) 185 REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:) 186 REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:) 187 REAL,ALLOCATABLE,SAVE :: zdtfi_omp(:,:) 188 REAL,ALLOCATABLE,SAVE :: zdqfi_omp(:,:,:) 189 REAL,ALLOCATABLE,SAVE :: zdpsrf_omp(:) 190 REAL,SAVE,ALLOCATABLE :: flxwfi_omp(:,:) ! Flux de masse verticale sur la grille physiq 191 192 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 193 ! Introduction du splitting (FH) 194 ! Question pour Yann : 195 ! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent 196 ! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il 197 ! soit allocatable (plutot par exemple que de passer une dimension 198 ! dépendant du process en argument des routines) et que, du coup, 199 ! le SAVE évite d'avoir à refaire l'allocation à chaque appel. 200 ! Tu confirmes ? 201 ! J'ai suivi le même principe pour les zdufic_omp 202 ! Mais c'est surement bien que tu controles. 203 ! 204 205 REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:) 206 REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:) 207 REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:) 208 REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:) 209 REAL jH_cur_split,zdt_split 210 LOGICAL debut_split,lafin_split 211 INTEGER isplit 212 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 213 214 c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zpk_omp,zphi_omp,zphis_omp, 215 c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, 216 c$OMP+ zrfi_omp,zqfi_omp,zdufi_omp,zdvfi_omp, 217 c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp, 218 c$OMP+ zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp) 219 220 LOGICAL,SAVE :: first_omp=.true. 221 c$OMP THREADPRIVATE(first_omp) 222 223 REAL zsin(iim),zcos(iim),z1(iim) 224 REAL zsinbis(iim),zcosbis(iim),z1bis(iim) 225 REAL unskap, pksurcp 226 c 227 REAL SSUM 228 229 LOGICAL,SAVE :: firstcal=.true., debut=.true. 230 c$OMP THREADPRIVATE(firstcal,debut) 231 232 REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv 233 INTEGER :: ierr 234 INTEGER,dimension(MPI_STATUS_SIZE,4) :: Status 235 INTEGER, dimension(4) :: Req 236 REAL,ALLOCATABLE,SAVE:: zdufi2(:,:),zdvfi2(:,:) 237 integer :: k,kstart,kend 238 INTEGER :: offset 239 INTEGER :: jjb,jje 240 241 c 242 c----------------------------------------------------------------------- 243 c 244 c 1. Initialisations : 245 c -------------------- 246 c 247 248 klon=klon_mpi 249 250 c 251 IF ( firstcal ) THEN 252 debut = .TRUE. 253 IF (ngridmx.NE.2+(jjm-1)*iim) THEN 254 write(lunout,*) 'STOP dans calfis' 255 write(lunout,*) 256 & 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 257 write(lunout,*) ' ngridmx jjm iim ' 258 write(lunout,*) ngridmx,jjm,iim 259 call abort_gcm("calfis_loc", "", 1) 260 ENDIF 261 c$OMP MASTER 262 ALLOCATE(zpsrf(klon)) 263 ALLOCATE(zplev(klon,llm+1),zplay(klon,llm)) 264 ALLOCATE(zphi(klon,llm),zphis(klon)) 265 ALLOCATE(zufi(klon,llm), zvfi(klon,llm),zrfi(klon,llm)) 266 ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot)) 267 ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm)) 268 ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2)) 269 ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm)) 270 ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot)) 271 ALLOCATE(zdpsrf(klon)) 272 ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm)) 273 ALLOCATE(flxwfi(klon,llm)) 274 ALLOCATE(zpk(klon,llm)) 275 c$OMP END MASTER 276 c$OMP BARRIER 277 ELSE 278 debut = .FALSE. 279 ENDIF 280 281 c 282 c 283 c----------------------------------------------------------------------- 284 c 40. transformation des variables dynamiques en variables physiques: 285 c --------------------------------------------------------------- 286 287 c 41. pressions au sol (en Pascals) 288 c ---------------------------------- 289 290 c$OMP MASTER 291 call start_timer(timer_physic) 292 c$OMP END MASTER 293 294 c$OMP MASTER 295 !CDIR ON_ADB(index_i) 296 !CDIR ON_ADB(index_j) 297 do ig0=1,klon 298 i=index_i(ig0) 299 j=index_j(ig0) 300 zpsrf(ig0)=pps(i,j) 722 do isplit=1,nsplit_phys 723 724 jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys) 725 debut_split=debut.and.isplit==1 726 lafin_split=lafin.and.isplit==nsplit_phys 727 728 CALL call_physiq(klon,llm,nqtot,tracers(:)%name, & 729 debut_split,lafin_split, & 730 jD_cur,jH_cur_split,zdt_split, & 731 zplev_omp,zplay_omp, & 732 zpk_omp,zphi_omp,zphis_omp, & 733 presnivs_omp, & 734 zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp, & 735 flxwfi_omp,pducov, & 736 zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp, & 737 zdpsrf_omp) 738 739 740 zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split 741 zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split 742 ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split 743 zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split 744 745 zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:) 746 zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:) 747 zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:) 748 zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:) 749 750 enddo 751 752 #endif 753 ! of #ifdef CPP_PHYS 754 755 756 zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys 757 zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys 758 zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys 759 zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys 760 761 !$OMP BARRIER 762 763 do l=1,llm+1 764 do i=1,klon 765 zplev(offset+i,l)=zplev_omp(i,l) 766 enddo 767 enddo 768 769 do l=1,llm 770 do i=1,klon 771 zplay(offset+i,l)=zplay_omp(i,l) 772 enddo 773 enddo 774 775 do l=1,llm 776 do i=1,klon 777 zphi(offset+i,l)=zphi_omp(i,l) 778 enddo 779 enddo 780 781 782 do i=1,klon 783 zphis(offset+i)=zphis_omp(i) 784 enddo 785 786 787 do l=1,llm 788 presnivs(l)=presnivs_omp(l) 789 enddo 790 791 do l=1,llm 792 do i=1,klon 793 zufi(offset+i,l)=zufi_omp(i,l) 794 enddo 795 enddo 796 797 do l=1,llm 798 do i=1,klon 799 zvfi(offset+i,l)=zvfi_omp(i,l) 800 enddo 801 enddo 802 803 do l=1,llm 804 do i=1,klon 805 ztfi(offset+i,l)=ztfi_omp(i,l) 806 enddo 807 enddo 808 809 do iq=1,nqtot 810 do l=1,llm 811 do i=1,klon 812 zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq) 301 813 enddo 302 c$OMP END MASTER 303 304 305 c 42. pression intercouches : 306 c 307 c ----------------------------------------------------------------- 308 c .... zplev definis aux (llm +1) interfaces des couches .... 309 c .... zplay definis aux ( llm ) milieux des couches .... 310 c ----------------------------------------------------------------- 311 312 c ... Exner = cp * ( p(l) / preff ) ** kappa .... 313 c 314 unskap = 1./ kappa 315 c 316 c print *,omp_rank,'klon--->',klon 317 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 318 DO l = 1, llmp1 319 !CDIR ON_ADB(index_i) 320 !CDIR ON_ADB(index_j) 321 do ig0=1,klon 814 enddo 815 enddo 816 817 do l=1,llm 818 do i=1,klon 819 zdufi(offset+i,l)=zdufi_omp(i,l) 820 enddo 821 enddo 822 823 do l=1,llm 824 do i=1,klon 825 zdvfi(offset+i,l)=zdvfi_omp(i,l) 826 enddo 827 enddo 828 829 do l=1,llm 830 do i=1,klon 831 zdtfi(offset+i,l)=zdtfi_omp(i,l) 832 enddo 833 enddo 834 835 do iq=1,nqtot 836 do l=1,llm 837 do i=1,klon 838 zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq) 839 enddo 840 enddo 841 enddo 842 843 do i=1,klon 844 zdpsrf(offset+i)=zdpsrf_omp(i) 845 enddo 846 847 848 klon=klon_mpi 849 500 CONTINUE 850 !$OMP BARRIER 851 852 !$OMP MASTER 853 call stop_timer(timer_physic) 854 !$OMP END MASTER 855 856 IF (using_mpi) THEN 857 858 if (MPI_rank>0) then 859 860 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 861 DO l=1,llm 862 du_send(1:iim,l)=zdufi(1:iim,l) 863 dv_send(1:iim,l)=zdvfi(1:iim,l) 864 ENDDO 865 !$OMP END DO NOWAIT 866 867 !$OMP BARRIER 868 869 !$OMP MASTER 870 !$OMP CRITICAL (MPI) 871 call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401, & 872 COMM_LMDZ,Req(1),ierr) 873 call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402, & 874 COMM_LMDZ,Req(2),ierr) 875 !$OMP END CRITICAL (MPI) 876 !$OMP END MASTER 877 878 !$OMP BARRIER 879 880 endif 881 882 if (MPI_rank<MPI_Size-1) then 883 !$OMP BARRIER 884 885 !$OMP MASTER 886 !$OMP CRITICAL (MPI) 887 call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401, & 888 COMM_LMDZ,Req(3),ierr) 889 call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402, & 890 COMM_LMDZ,Req(4),ierr) 891 !$OMP END CRITICAL (MPI) 892 !$OMP END MASTER 893 894 endif 895 896 !$OMP BARRIER 897 898 899 !$OMP MASTER 900 !$OMP CRITICAL (MPI) 901 if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then 902 call MPI_WAITALL(4,Req(1),Status,ierr) 903 else if (MPI_rank>0) then 904 call MPI_WAITALL(2,Req(1),Status,ierr) 905 else if (MPI_rank <MPI_Size-1) then 906 call MPI_WAITALL(2,Req(3),Status,ierr) 907 endif 908 !$OMP END CRITICAL (MPI) 909 !$OMP END MASTER 910 911 !$OMP BARRIER 912 913 ENDIF ! using_mpi 914 915 916 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 917 DO l=1,llm 918 919 zdufi2(1:klon,l)=zdufi(1:klon,l) 920 zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l) 921 922 zdvfi2(1:klon,l)=zdvfi(1:klon,l) 923 zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l) 924 925 pdhfi(:,jj_begin,l)=0 926 pdqfi(:,jj_begin,l,:)=0 927 pdufi(:,jj_begin,l)=0 928 pdvfi(:,jj_begin,l)=0 929 930 if (.not. is_south_pole_dyn) then 931 pdhfi(:,jj_end:jj_end+1,l)=0 932 pdqfi(:,jj_end:jj_end+1,l,:)=0 933 pdufi(:,jj_end:jj_end+1,l)=0 934 pdvfi(:,jj_end:jj_end+1,l)=0 935 endif 936 937 ENDDO 938 !$OMP END DO NOWAIT 939 940 !$OMP MASTER 941 pdpsfi(:,jj_begin)=0 942 943 if (.not. is_south_pole_dyn) then 944 pdpsfi(:,jj_end:jj_end+1)=0 945 endif 946 !$OMP END MASTER 947 !----------------------------------------------------------------------- 948 ! transformation des tendances physiques en tendances dynamiques: 949 ! --------------------------------------------------------------- 950 951 ! tendance sur la pression : 952 ! ----------------------------------- 953 ! CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi) 954 955 !$OMP MASTER 956 kstart=1 957 kend=klon 958 959 if (is_north_pole_dyn) kstart=2 960 if (is_south_pole_dyn) kend=klon-1 961 962 !CDIR ON_ADB(index_i) 963 !CDIR ON_ADB(index_j) 964 !cdir NODEP 965 do ig0=kstart,kend 966 i=index_i(ig0) 967 j=index_j(ig0) 968 pdpsfi(i,j) = zdpsrf(ig0) 969 if (i==1) pdpsfi(iip1,j) = zdpsrf(ig0) 970 enddo 971 972 if (is_north_pole_dyn) then 973 DO i=1,iip1 974 pdpsfi(i,1) = zdpsrf(1) 975 enddo 976 endif 977 978 if (is_south_pole_dyn) then 979 DO i=1,iip1 980 pdpsfi(i,jjp1) = zdpsrf(klon) 981 ENDDO 982 endif 983 !$OMP END MASTER 984 !c$OMP BARRIER 985 986 ! 987 ! 62. enthalpie potentielle 988 ! --------------------- 989 990 kstart=1 991 kend=klon 992 993 if (is_north_pole_dyn) kstart=2 994 if (is_south_pole_dyn) kend=klon-1 995 996 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 997 DO l=1,llm 998 999 !CDIR ON_ADB(index_i) 1000 !CDIR ON_ADB(index_j) 1001 !cdir NODEP 1002 do ig0=kstart,kend 1003 i=index_i(ig0) 1004 j=index_j(ig0) 1005 pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l) 1006 if (i==1) pdhfi(iip1,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l) 1007 enddo 1008 1009 if (is_north_pole_dyn) then 1010 DO i=1,iip1 1011 pdhfi(i,1,l) = cpp * zdtfi(1,l) / ppk(i, 1 ,l) 1012 enddo 1013 endif 1014 1015 if (is_south_pole_dyn) then 1016 DO i=1,iip1 1017 pdhfi(i,jjp1,l) = cpp * zdtfi(klon,l)/ ppk(i,jjp1,l) 1018 ENDDO 1019 endif 1020 ENDDO 1021 !$OMP END DO NOWAIT 1022 1023 ! 62. humidite specifique 1024 ! --------------------- 1025 ! Ehouarn: removed this useless bit: was overwritten at step 63 anyways 1026 ! DO iq=1,nqtot 1027 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1028 ! DO l=1,llm 1029 !!!cdir NODEP 1030 ! do ig0=kstart,kend 1031 ! i=index_i(ig0) 1032 ! j=index_j(ig0) 1033 ! pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq) 1034 ! if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq) 1035 ! enddo 1036 ! 1037 ! if (is_north_pole_dyn) then 1038 ! do i=1,iip1 1039 ! pdqfi(i,1,l,iq) = zdqfi(1,l,iq) 1040 ! enddo 1041 ! endif 1042 ! 1043 ! if (is_south_pole_dyn) then 1044 ! do i=1,iip1 1045 ! pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq) 1046 ! enddo 1047 ! endif 1048 ! ENDDO 1049 !c$OMP END DO NOWAIT 1050 ! ENDDO 1051 1052 ! 63. traceurs 1053 ! ------------ 1054 ! initialisation des tendances 1055 1056 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1057 DO l=1,llm 1058 pdqfi(:,jj_begin:jj_end,l,:)=0. 1059 ENDDO 1060 !$OMP END DO NOWAIT 1061 1062 ! 1063 !cdir NODEP 1064 itr = 0 1065 DO iq=1,nqtot 1066 IF(.NOT.tracers(iq)%isAdvected) CYCLE 1067 itr = itr + 1 1068 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1069 DO l=1,llm 1070 !CDIR ON_ADB(index_i) 1071 !CDIR ON_ADB(index_j) 1072 !cdir NODEP 1073 DO ig0=kstart,kend 322 1074 i=index_i(ig0) 323 1075 j=index_j(ig0) 324 zplev( ig0,l ) = pp(i,j,l) 325 enddo 1076 pdqfi(i,j,l,iq) = zdqfi(ig0,l,itr) 1077 if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,itr) 1078 ENDDO 1079 1080 IF (is_north_pole_dyn) then 1081 DO i=1,iip1 1082 pdqfi(i,1,l,iq) = zdqfi(1,l,itr) 1083 ENDDO 1084 ENDIF 1085 1086 IF (is_south_pole_dyn) then 1087 DO i=1,iip1 1088 pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,itr) 1089 ENDDO 1090 ENDIF 1091 1092 ENDDO 1093 !$OMP END DO NOWAIT 1094 ENDDO 1095 1096 ! 65. champ u: 1097 ! ------------ 1098 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1099 DO l=1,llm 1100 !CDIR ON_ADB(index_i) 1101 !CDIR ON_ADB(index_j) 1102 !cdir NODEP 1103 do ig0=kstart,kend 1104 i=index_i(ig0) 1105 j=index_j(ig0) 1106 1107 if (i/=iim) then 1108 pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j) 1109 endif 1110 1111 if (i==1) then 1112 pdufi(iim,j,l)=0.5*( zdufi2(ig0,l) & 1113 + zdufi2(ig0+iim-1,l))*cu(iim,j) 1114 pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j) 1115 endif 1116 1117 enddo 1118 1119 if (is_north_pole_dyn) then 1120 DO i=1,iip1 1121 pdufi(i,1,l) = 0. 1122 ENDDO 1123 endif 1124 1125 if (is_south_pole_dyn) then 1126 DO i=1,iip1 1127 pdufi(i,jjp1,l) = 0. 1128 ENDDO 1129 endif 1130 1131 ENDDO 1132 !$OMP END DO NOWAIT 1133 1134 ! 67. champ v: 1135 ! ------------ 1136 1137 kstart=1 1138 kend=klon 1139 1140 if (is_north_pole_dyn) kstart=2 1141 if (is_south_pole_dyn) kend=klon-1-iim 1142 1143 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1144 DO l=1,llm 1145 !CDIR ON_ADB(index_i) 1146 !CDIR ON_ADB(index_j) 1147 !cdir NODEP 1148 do ig0=kstart,kend 1149 i=index_i(ig0) 1150 j=index_j(ig0) 1151 pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))*cv(i,j) 1152 if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+ & 1153 zdvfi2(ig0+iim,l)) & 1154 *cv(i,j) 1155 enddo 1156 1157 ENDDO 1158 !$OMP END DO NOWAIT 1159 1160 1161 ! 68. champ v pres des poles: 1162 ! --------------------------- 1163 ! v = U * cos(long) + V * SIN(long) 1164 1165 if (is_north_pole_dyn) then 1166 1167 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1168 DO l=1,llm 1169 1170 DO i=1,iim 1171 pdvfi(i,1,l)= & 1172 zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i)) 1173 1174 pdvfi(i,1,l)= & 1175 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1) 326 1176 ENDDO 327 c$OMP END DO NOWAIT 328 329 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 330 DO l=1,llm 331 do ig0=1,klon 332 i=index_i(ig0) 333 j=index_j(ig0) 334 zpk(ig0,l)=ppk(i,j,l) 335 enddo 336 ENDDO 337 c$OMP END DO NOWAIT 338 339 c 340 c 341 342 c 43. temperature naturelle (en K) et pressions milieux couches . 343 c --------------------------------------------------------------- 344 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 345 DO l=1,llm 346 !CDIR ON_ADB(index_i) 347 !CDIR ON_ADB(index_j) 348 do ig0=1,klon 349 i=index_i(ig0) 350 j=index_j(ig0) 351 pksurcp = ppk(i,j,l) / cpp 352 zplay(ig0,l) = preff * pksurcp ** unskap 353 ztfi(ig0,l) = pteta(i,j,l) * pksurcp 354 enddo 355 356 ENDDO 357 c$OMP END DO NOWAIT 358 359 c 43.bis traceurs 360 c --------------- 361 c 362 363 itr = 0 364 DO iq=1,nqtot 365 IF(.NOT.tracers(iq)%isAdvected) CYCLE 366 itr = itr + 1 367 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 368 DO l=1,llm 369 !CDIR ON_ADB(index_i) 370 !CDIR ON_ADB(index_j) 371 do ig0=1,klon 372 i=index_i(ig0) 373 j=index_j(ig0) 374 zqfi(ig0,l,itr) = pq(i,j,l,iq) 375 enddo 376 ENDDO 377 c$OMP END DO NOWAIT 378 ENDDO 379 380 381 c Geopotentiel calcule par rapport a la surface locale: 382 c ----------------------------------------------------- 383 384 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 385 DO l=1,llm 386 !CDIR ON_ADB(index_i) 387 !CDIR ON_ADB(index_j) 388 do ig0=1,klon 389 i=index_i(ig0) 390 j=index_j(ig0) 391 zphi(ig0,l) = pphi(i,j,l) 392 enddo 393 ENDDO 394 c$OMP END DO NOWAIT 395 396 c CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi) 397 398 c$OMP MASTER 399 !CDIR ON_ADB(index_i) 400 !CDIR ON_ADB(index_j) 401 do ig0=1,klon 402 i=index_i(ig0) 403 j=index_j(ig0) 404 zphis(ig0) = pphis(i,j) 405 enddo 406 c$OMP END MASTER 407 408 409 c CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis) 410 411 c$OMP BARRIER 412 413 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 414 DO l=1,llm 415 DO ig=1,klon 416 zphi(ig,l)=zphi(ig,l)-zphis(ig) 417 ENDDO 418 ENDDO 419 c$OMP END DO NOWAIT 420 421 422 c 423 c 45. champ u: 424 c ------------ 425 426 kstart=1 427 kend=klon 428 429 if (is_north_pole_dyn) kstart=2 430 if (is_south_pole_dyn) kend=klon-1 431 432 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 433 DO l=1,llm 434 !CDIR ON_ADB(index_i) 435 !CDIR ON_ADB(index_j) 436 !CDIR SPARSE 437 do ig0=kstart,kend 438 i=index_i(ig0) 439 j=index_j(ig0) 440 if (i==1) then 441 zufi(ig0,l)= 0.5 *( pucov(iim,j,l)/cu(iim,j) 442 $ + pucov(1,j,l)/cu(1,j) ) 443 else 444 zufi(ig0,l)= 0.5*( pucov(i-1,j,l)/cu(i-1,j) 445 $ + pucov(i,j,l)/cu(i,j) ) 446 endif 447 enddo 448 ENDDO 449 c$OMP END DO NOWAIT 450 451 c 452 C Alvaro de la Camara (May 2014) 453 C 46.1 Calcul de la vorticite et passage sur la grille physique 454 C -------------------------------------------------------------- 455 456 jjb=jj_begin_dyn-1 457 jje=jj_end_dyn+1 458 if (is_north_pole_dyn) jjb=1 459 if (is_south_pole_dyn) jje=jjm 460 461 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 462 463 DO l=1,llm 464 do i=1,iim 465 do j=jjb,jje 466 zrot(i,j,l) = (pvcov(i+1,j,l) - pvcov(i,j,l) 467 $ + pucov(i,j+1,l) - pucov(i,j,l)) 468 $ / (cu(i,j)+cu(i,j+1)) 469 $ / (cv(i+1,j)+cv(i,j)) *4 470 enddo 471 enddo 472 ENDDO 473 474 475 c 46.2champ v: 476 c ----------- 477 478 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 479 DO l=1,llm 480 !CDIR ON_ADB(index_i) 481 !CDIR ON_ADB(index_j) 482 DO ig0=kstart,kend 483 i=index_i(ig0) 484 j=index_j(ig0) 485 zvfi(ig0,l)= 0.5 *( pvcov(i,j-1,l)/cv(i,j-1) 486 $ + pvcov(i,j,l)/cv(i,j) ) 487 if (j==1 .OR. j==jjp1) then ! AdlC MAY 2014 488 zrfi(ig0,l) = 0 ! AdlC MAY 2014 489 else 490 if(i==1)then 491 zrfi(ig0,l)= 0.25 *(zrot(iim,j-1,l)+zrot(iim,j,l) 492 $ +zrot(1,j-1,l)+zrot(1,j,l)) ! AdlC MAY 2014 493 else 494 zrfi(ig0,l)= 0.25 *(zrot(i-1,j-1,l)+zrot(i-1,j,l) 495 $ +zrot(i,j-1,l)+zrot(i,j,l)) ! AdlC MAY 2014 496 endif 497 endif 498 499 500 ENDDO 501 ENDDO 502 c$OMP END DO NOWAIT 503 504 c 47. champs de vents aux pole nord 505 c ------------------------------ 506 c U = 1 / pi * integrale [ v * cos(long) * d long ] 507 c V = 1 / pi * integrale [ v * sin(long) * d long ] 508 509 if (is_north_pole_dyn) then 510 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 511 DO l=1,llm 512 513 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1) 514 DO i=2,iim 515 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1) 516 ENDDO 517 518 DO i=1,iim 519 zcos(i) = COS(rlonv(i))*z1(i) 520 zsin(i) = SIN(rlonv(i))*z1(i) 521 ENDDO 522 523 zufi(1,l) = SSUM(iim,zcos,1)/pi 524 zvfi(1,l) = SSUM(iim,zsin,1)/pi 525 zrfi(1,l) = 0. 526 527 ENDDO 528 c$OMP END DO NOWAIT 529 endif 530 531 532 c 48. champs de vents aux pole sud: 533 c --------------------------------- 534 c U = 1 / pi * integrale [ v * cos(long) * d long ] 535 c V = 1 / pi * integrale [ v * sin(long) * d long ] 536 537 if (is_south_pole_dyn) then 538 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 539 DO l=1,llm 540 541 z1(1) =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm) 542 DO i=2,iim 543 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm) 544 ENDDO 545 546 DO i=1,iim 547 zcos(i) = COS(rlonv(i))*z1(i) 548 zsin(i) = SIN(rlonv(i))*z1(i) 549 ENDDO 550 551 zufi(klon,l) = SSUM(iim,zcos,1)/pi 552 zvfi(klon,l) = SSUM(iim,zsin,1)/pi 553 zrfi(klon,l) = 0. 554 ENDDO 555 c$OMP END DO NOWAIT 556 endif 557 558 c On change de grille, dynamique vers physiq, pour le flux de masse verticale 559 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 560 DO l=1,llm 561 !CDIR ON_ADB(index_i) 562 !CDIR ON_ADB(index_j) 563 do ig0=1,klon 564 i=index_i(ig0) 565 j=index_j(ig0) 566 flxwfi(ig0,l) = flxw(i,j,l) 567 enddo 568 ENDDO 569 c$OMP END DO NOWAIT 570 571 c CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi) 572 573 c----------------------------------------------------------------------- 574 c Appel de la physique: 575 c --------------------- 576 577 578 c$OMP BARRIER 579 if (first_omp) then 580 klon=klon_omp 581 582 allocate(zplev_omp(klon,llm+1)) 583 allocate(zplay_omp(klon,llm)) 584 allocate(zpk_omp(klon,llm)) 585 allocate(zphi_omp(klon,llm)) 586 allocate(zphis_omp(klon)) 587 allocate(presnivs_omp(llm)) 588 allocate(zufi_omp(klon,llm)) 589 allocate(zvfi_omp(klon,llm)) 590 allocate(zrfi_omp(klon,llm)) ! LG Ari 2014 591 allocate(ztfi_omp(klon,llm)) 592 allocate(zqfi_omp(klon,llm,nqtot)) 593 allocate(zdufi_omp(klon,llm)) 594 allocate(zdvfi_omp(klon,llm)) 595 allocate(zdtfi_omp(klon,llm)) 596 allocate(zdqfi_omp(klon,llm,nqtot)) 597 allocate(zdufic_omp(klon,llm)) 598 allocate(zdvfic_omp(klon,llm)) 599 allocate(zdtfic_omp(klon,llm)) 600 allocate(zdqfic_omp(klon,llm,nqtot)) 601 allocate(zdpsrf_omp(klon)) 602 allocate(flxwfi_omp(klon,llm)) 603 first_omp=.false. 604 endif 605 606 607 klon=klon_omp 608 offset=klon_omp_begin-1 609 610 do l=1,llm+1 611 do i=1,klon 612 zplev_omp(i,l)=zplev(offset+i,l) 613 enddo 614 enddo 615 616 do l=1,llm 617 do i=1,klon 618 zplay_omp(i,l)=zplay(offset+i,l) 619 enddo 620 enddo 621 622 do l=1,llm 623 do i=1,klon 624 zpk_omp(i,l)=zpk(offset+i,l) 625 enddo 626 enddo 627 628 do l=1,llm 629 do i=1,klon 630 zphi_omp(i,l)=zphi(offset+i,l) 631 enddo 632 enddo 633 634 do i=1,klon 635 zphis_omp(i)=zphis(offset+i) 636 enddo 637 638 639 do l=1,llm 640 presnivs_omp(l)=presnivs(l) 641 enddo 642 643 do l=1,llm 644 do i=1,klon 645 zufi_omp(i,l)=zufi(offset+i,l) 646 enddo 647 enddo 648 649 do l=1,llm 650 do i=1,klon 651 zvfi_omp(i,l)=zvfi(offset+i,l) 652 enddo 653 enddo 654 655 do l=1,llm 656 do i=1,klon 657 zrfi_omp(i,l)=zrfi(offset+i,l) 658 enddo 659 enddo 660 661 do l=1,llm 662 do i=1,klon 663 ztfi_omp(i,l)=ztfi(offset+i,l) 664 enddo 665 enddo 666 667 do iq=1,nqtot 668 do l=1,llm 669 do i=1,klon 670 zqfi_omp(i,l,iq)=zqfi(offset+i,l,iq) 671 enddo 672 enddo 673 enddo 674 675 do l=1,llm 676 do i=1,klon 677 zdufi_omp(i,l)=zdufi(offset+i,l) 678 enddo 679 enddo 680 681 do l=1,llm 682 do i=1,klon 683 zdvfi_omp(i,l)=zdvfi(offset+i,l) 684 enddo 685 enddo 686 687 do l=1,llm 688 do i=1,klon 689 zdtfi_omp(i,l)=zdtfi(offset+i,l) 690 enddo 691 enddo 692 693 do iq=1,nqtot 694 do l=1,llm 695 do i=1,klon 696 zdqfi_omp(i,l,iq)=zdqfi(offset+i,l,iq) 697 enddo 698 enddo 699 enddo 700 701 do i=1,klon 702 zdpsrf_omp(i)=zdpsrf(offset+i) 703 enddo 704 705 do l=1,llm 706 do i=1,klon 707 flxwfi_omp(i,l)=flxwfi(offset+i,l) 708 enddo 709 enddo 710 711 c$OMP BARRIER 712 713 714 !$OMP MASTER 715 ! write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 716 !$OMP END MASTER 717 zdt_split=dtphys/nsplit_phys 718 zdufic_omp(:,:)=0. 719 zdvfic_omp(:,:)=0. 720 zdtfic_omp(:,:)=0. 721 zdqfic_omp(:,:,:)=0. 722 723 #ifdef CPP_PHYS 724 do isplit=1,nsplit_phys 725 726 jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys) 727 debut_split=debut.and.isplit==1 728 lafin_split=lafin.and.isplit==nsplit_phys 729 730 CALL call_physiq(klon,llm,nqtot,tracers(:)%name, 731 & debut_split,lafin_split, 732 & jD_cur,jH_cur_split,zdt_split, 733 & zplev_omp,zplay_omp, 734 & zpk_omp,zphi_omp,zphis_omp, 735 & presnivs_omp, 736 & zufi_omp,zvfi_omp,zrfi_omp,ztfi_omp,zqfi_omp, 737 & flxwfi_omp,pducov, 738 & zdufi_omp,zdvfi_omp,zdtfi_omp,zdqfi_omp, 739 & zdpsrf_omp) 740 741 742 zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split 743 zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split 744 ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split 745 zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split 746 747 zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:) 748 zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:) 749 zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:) 750 zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:) 751 752 enddo 753 1177 1178 pdvfi(iip1,1,l) = pdvfi(1,1,l) 1179 1180 ENDDO 1181 !$OMP END DO NOWAIT 1182 1183 endif 1184 1185 if (is_south_pole_dyn) then 1186 1187 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1188 DO l=1,llm 1189 1190 DO i=1,iim 1191 pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i)) & 1192 +zdvfi(klon,l)*SIN(rlonv(i)) 1193 1194 pdvfi(i,jjm,l)= & 1195 0.5*(pdvfi(i,jjm,l)+zdvfi(klon-iip1+i,l))*cv(i,jjm) 1196 ENDDO 1197 1198 pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l) 1199 1200 ENDDO 1201 !$OMP END DO NOWAIT 1202 1203 endif 1204 !----------------------------------------------------------------------- 1205 1206 700 CONTINUE 1207 1208 firstcal = .FALSE. 754 1209 #endif 755 ! of #ifdef CPP_PHYS 756 757 758 zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys 759 zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys 760 zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys 761 zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys 762 763 c$OMP BARRIER 764 765 do l=1,llm+1 766 do i=1,klon 767 zplev(offset+i,l)=zplev_omp(i,l) 768 enddo 769 enddo 770 771 do l=1,llm 772 do i=1,klon 773 zplay(offset+i,l)=zplay_omp(i,l) 774 enddo 775 enddo 776 777 do l=1,llm 778 do i=1,klon 779 zphi(offset+i,l)=zphi_omp(i,l) 780 enddo 781 enddo 782 783 784 do i=1,klon 785 zphis(offset+i)=zphis_omp(i) 786 enddo 787 788 789 do l=1,llm 790 presnivs(l)=presnivs_omp(l) 791 enddo 792 793 do l=1,llm 794 do i=1,klon 795 zufi(offset+i,l)=zufi_omp(i,l) 796 enddo 797 enddo 798 799 do l=1,llm 800 do i=1,klon 801 zvfi(offset+i,l)=zvfi_omp(i,l) 802 enddo 803 enddo 804 805 do l=1,llm 806 do i=1,klon 807 ztfi(offset+i,l)=ztfi_omp(i,l) 808 enddo 809 enddo 810 811 do iq=1,nqtot 812 do l=1,llm 813 do i=1,klon 814 zqfi(offset+i,l,iq)=zqfi_omp(i,l,iq) 815 enddo 816 enddo 817 enddo 818 819 do l=1,llm 820 do i=1,klon 821 zdufi(offset+i,l)=zdufi_omp(i,l) 822 enddo 823 enddo 824 825 do l=1,llm 826 do i=1,klon 827 zdvfi(offset+i,l)=zdvfi_omp(i,l) 828 enddo 829 enddo 830 831 do l=1,llm 832 do i=1,klon 833 zdtfi(offset+i,l)=zdtfi_omp(i,l) 834 enddo 835 enddo 836 837 do iq=1,nqtot 838 do l=1,llm 839 do i=1,klon 840 zdqfi(offset+i,l,iq)=zdqfi_omp(i,l,iq) 841 enddo 842 enddo 843 enddo 844 845 do i=1,klon 846 zdpsrf(offset+i)=zdpsrf_omp(i) 847 enddo 848 849 850 klon=klon_mpi 851 500 CONTINUE 852 c$OMP BARRIER 853 854 c$OMP MASTER 855 call stop_timer(timer_physic) 856 c$OMP END MASTER 857 858 IF (using_mpi) THEN 859 860 if (MPI_rank>0) then 861 862 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 863 DO l=1,llm 864 du_send(1:iim,l)=zdufi(1:iim,l) 865 dv_send(1:iim,l)=zdvfi(1:iim,l) 866 ENDDO 867 c$OMP END DO NOWAIT 868 869 c$OMP BARRIER 870 871 c$OMP MASTER 872 !$OMP CRITICAL (MPI) 873 call MPI_ISSEND(du_send,iim*llm,MPI_REAL8,MPI_Rank-1,401, 874 & COMM_LMDZ,Req(1),ierr) 875 call MPI_ISSEND(dv_send,iim*llm,MPI_REAL8,MPI_Rank-1,402, 876 & COMM_LMDZ,Req(2),ierr) 877 !$OMP END CRITICAL (MPI) 878 c$OMP END MASTER 879 880 c$OMP BARRIER 881 882 endif 883 884 if (MPI_rank<MPI_Size-1) then 885 c$OMP BARRIER 886 887 c$OMP MASTER 888 !$OMP CRITICAL (MPI) 889 call MPI_IRECV(du_recv,iim*llm,MPI_REAL8,MPI_Rank+1,401, 890 & COMM_LMDZ,Req(3),ierr) 891 call MPI_IRECV(dv_recv,iim*llm,MPI_REAL8,MPI_Rank+1,402, 892 & COMM_LMDZ,Req(4),ierr) 893 !$OMP END CRITICAL (MPI) 894 c$OMP END MASTER 895 896 endif 897 898 c$OMP BARRIER 899 900 901 c$OMP MASTER 902 !$OMP CRITICAL (MPI) 903 if (MPI_rank>0 .and. MPI_rank< MPI_Size-1) then 904 call MPI_WAITALL(4,Req(1),Status,ierr) 905 else if (MPI_rank>0) then 906 call MPI_WAITALL(2,Req(1),Status,ierr) 907 else if (MPI_rank <MPI_Size-1) then 908 call MPI_WAITALL(2,Req(3),Status,ierr) 909 endif 910 !$OMP END CRITICAL (MPI) 911 c$OMP END MASTER 912 913 c$OMP BARRIER 914 915 ENDIF ! using_mpi 916 917 918 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 919 DO l=1,llm 920 921 zdufi2(1:klon,l)=zdufi(1:klon,l) 922 zdufi2(klon+1:klon+iim,l)=du_recv(1:iim,l) 923 924 zdvfi2(1:klon,l)=zdvfi(1:klon,l) 925 zdvfi2(klon+1:klon+iim,l)=dv_recv(1:iim,l) 926 927 pdhfi(:,jj_begin,l)=0 928 pdqfi(:,jj_begin,l,:)=0 929 pdufi(:,jj_begin,l)=0 930 pdvfi(:,jj_begin,l)=0 931 932 if (.not. is_south_pole_dyn) then 933 pdhfi(:,jj_end:jj_end+1,l)=0 934 pdqfi(:,jj_end:jj_end+1,l,:)=0 935 pdufi(:,jj_end:jj_end+1,l)=0 936 pdvfi(:,jj_end:jj_end+1,l)=0 937 endif 938 939 ENDDO 940 c$OMP END DO NOWAIT 941 942 c$OMP MASTER 943 pdpsfi(:,jj_begin)=0 944 945 if (.not. is_south_pole_dyn) then 946 pdpsfi(:,jj_end:jj_end+1)=0 947 endif 948 c$OMP END MASTER 949 c----------------------------------------------------------------------- 950 c transformation des tendances physiques en tendances dynamiques: 951 c --------------------------------------------------------------- 952 953 c tendance sur la pression : 954 c ----------------------------------- 955 c CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi) 956 957 c$OMP MASTER 958 kstart=1 959 kend=klon 960 961 if (is_north_pole_dyn) kstart=2 962 if (is_south_pole_dyn) kend=klon-1 963 964 !CDIR ON_ADB(index_i) 965 !CDIR ON_ADB(index_j) 966 !cdir NODEP 967 do ig0=kstart,kend 968 i=index_i(ig0) 969 j=index_j(ig0) 970 pdpsfi(i,j) = zdpsrf(ig0) 971 if (i==1) pdpsfi(iip1,j) = zdpsrf(ig0) 972 enddo 973 974 if (is_north_pole_dyn) then 975 DO i=1,iip1 976 pdpsfi(i,1) = zdpsrf(1) 977 enddo 978 endif 979 980 if (is_south_pole_dyn) then 981 DO i=1,iip1 982 pdpsfi(i,jjp1) = zdpsrf(klon) 983 ENDDO 984 endif 985 c$OMP END MASTER 986 cc$OMP BARRIER 987 988 c 989 c 62. enthalpie potentielle 990 c --------------------- 991 992 kstart=1 993 kend=klon 994 995 if (is_north_pole_dyn) kstart=2 996 if (is_south_pole_dyn) kend=klon-1 997 998 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 999 DO l=1,llm 1000 1001 !CDIR ON_ADB(index_i) 1002 !CDIR ON_ADB(index_j) 1003 !cdir NODEP 1004 do ig0=kstart,kend 1005 i=index_i(ig0) 1006 j=index_j(ig0) 1007 pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l) 1008 if (i==1) pdhfi(iip1,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l) 1009 enddo 1010 1011 if (is_north_pole_dyn) then 1012 DO i=1,iip1 1013 pdhfi(i,1,l) = cpp * zdtfi(1,l) / ppk(i, 1 ,l) 1014 enddo 1015 endif 1016 1017 if (is_south_pole_dyn) then 1018 DO i=1,iip1 1019 pdhfi(i,jjp1,l) = cpp * zdtfi(klon,l)/ ppk(i,jjp1,l) 1020 ENDDO 1021 endif 1022 ENDDO 1023 c$OMP END DO NOWAIT 1024 1025 c 62. humidite specifique 1026 c --------------------- 1027 ! Ehouarn: removed this useless bit: was overwritten at step 63 anyways 1028 ! DO iq=1,nqtot 1029 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1030 ! DO l=1,llm 1031 !!!cdir NODEP 1032 ! do ig0=kstart,kend 1033 ! i=index_i(ig0) 1034 ! j=index_j(ig0) 1035 ! pdqfi(i,j,l,iq) = zdqfi(ig0,l,iq) 1036 ! if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,iq) 1037 ! enddo 1038 ! 1039 ! if (is_north_pole_dyn) then 1040 ! do i=1,iip1 1041 ! pdqfi(i,1,l,iq) = zdqfi(1,l,iq) 1042 ! enddo 1043 ! endif 1044 ! 1045 ! if (is_south_pole_dyn) then 1046 ! do i=1,iip1 1047 ! pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,iq) 1048 ! enddo 1049 ! endif 1050 ! ENDDO 1051 !c$OMP END DO NOWAIT 1052 ! ENDDO 1053 1054 c 63. traceurs 1055 c ------------ 1056 C initialisation des tendances 1057 1058 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1059 DO l=1,llm 1060 pdqfi(:,jj_begin:jj_end,l,:)=0. 1061 ENDDO 1062 c$OMP END DO NOWAIT 1063 1064 C 1065 !cdir NODEP 1066 itr = 0 1067 DO iq=1,nqtot 1068 IF(.NOT.tracers(iq)%isAdvected) CYCLE 1069 itr = itr + 1 1070 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1071 DO l=1,llm 1072 !CDIR ON_ADB(index_i) 1073 !CDIR ON_ADB(index_j) 1074 !cdir NODEP 1075 DO ig0=kstart,kend 1076 i=index_i(ig0) 1077 j=index_j(ig0) 1078 pdqfi(i,j,l,iq) = zdqfi(ig0,l,itr) 1079 if (i==1) pdqfi(iip1,j,l,iq) = zdqfi(ig0,l,itr) 1080 ENDDO 1081 1082 IF (is_north_pole_dyn) then 1083 DO i=1,iip1 1084 pdqfi(i,1,l,iq) = zdqfi(1,l,itr) 1085 ENDDO 1086 ENDIF 1087 1088 IF (is_south_pole_dyn) then 1089 DO i=1,iip1 1090 pdqfi(i,jjp1,l,iq) = zdqfi(klon,l,itr) 1091 ENDDO 1092 ENDIF 1093 1094 ENDDO 1095 c$OMP END DO NOWAIT 1096 ENDDO 1097 1098 c 65. champ u: 1099 c ------------ 1100 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1101 DO l=1,llm 1102 !CDIR ON_ADB(index_i) 1103 !CDIR ON_ADB(index_j) 1104 !cdir NODEP 1105 do ig0=kstart,kend 1106 i=index_i(ig0) 1107 j=index_j(ig0) 1108 1109 if (i/=iim) then 1110 pdufi(i,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j) 1111 endif 1112 1113 if (i==1) then 1114 pdufi(iim,j,l)=0.5*( zdufi2(ig0,l) 1115 $ + zdufi2(ig0+iim-1,l))*cu(iim,j) 1116 pdufi(iip1,j,l)=0.5*(zdufi2(ig0,l)+zdufi2(ig0+1,l))*cu(i,j) 1117 endif 1118 1119 enddo 1120 1121 if (is_north_pole_dyn) then 1122 DO i=1,iip1 1123 pdufi(i,1,l) = 0. 1124 ENDDO 1125 endif 1126 1127 if (is_south_pole_dyn) then 1128 DO i=1,iip1 1129 pdufi(i,jjp1,l) = 0. 1130 ENDDO 1131 endif 1132 1133 ENDDO 1134 c$OMP END DO NOWAIT 1135 1136 c 67. champ v: 1137 c ------------ 1138 1139 kstart=1 1140 kend=klon 1141 1142 if (is_north_pole_dyn) kstart=2 1143 if (is_south_pole_dyn) kend=klon-1-iim 1144 1145 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1146 DO l=1,llm 1147 !CDIR ON_ADB(index_i) 1148 !CDIR ON_ADB(index_j) 1149 !cdir NODEP 1150 do ig0=kstart,kend 1151 i=index_i(ig0) 1152 j=index_j(ig0) 1153 pdvfi(i,j,l)=0.5*(zdvfi2(ig0,l)+zdvfi2(ig0+iim,l))*cv(i,j) 1154 if (i==1) pdvfi(iip1,j,l) = 0.5*(zdvfi2(ig0,l)+ 1155 $ zdvfi2(ig0+iim,l)) 1156 $ *cv(i,j) 1157 enddo 1158 1159 ENDDO 1160 c$OMP END DO NOWAIT 1161 1162 1163 c 68. champ v pres des poles: 1164 c --------------------------- 1165 c v = U * cos(long) + V * SIN(long) 1166 1167 if (is_north_pole_dyn) then 1168 1169 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1170 DO l=1,llm 1171 1172 DO i=1,iim 1173 pdvfi(i,1,l)= 1174 $ zdufi(1,l)*COS(rlonv(i))+zdvfi(1,l)*SIN(rlonv(i)) 1175 1176 pdvfi(i,1,l)= 1177 $ 0.5*(pdvfi(i,1,l)+zdvfi(i+1,l))*cv(i,1) 1178 ENDDO 1179 1180 pdvfi(iip1,1,l) = pdvfi(1,1,l) 1181 1182 ENDDO 1183 c$OMP END DO NOWAIT 1184 1185 endif 1186 1187 if (is_south_pole_dyn) then 1188 1189 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1190 DO l=1,llm 1191 1192 DO i=1,iim 1193 pdvfi(i,jjm,l)=zdufi(klon,l)*COS(rlonv(i)) 1194 $ +zdvfi(klon,l)*SIN(rlonv(i)) 1195 1196 pdvfi(i,jjm,l)= 1197 $ 0.5*(pdvfi(i,jjm,l)+zdvfi(klon-iip1+i,l))*cv(i,jjm) 1198 ENDDO 1199 1200 pdvfi(iip1,jjm,l)= pdvfi(1,jjm,l) 1201 1202 ENDDO 1203 c$OMP END DO NOWAIT 1204 1205 endif 1206 c----------------------------------------------------------------------- 1207 1208 700 CONTINUE 1209 1210 firstcal = .FALSE. 1211 1212 #else 1213 call abort_gcm("calfis_loc", 1214 & "calfis_p: for now can only work with parallel physics", 1) 1215 #endif 1216 ! of #ifdef CPP_PHYS 1210 ! of #ifdef CPP_PHYS 1211 END SUBROUTINE calfis_loc 1212 1213 END MODULE lmdz_calfis_loc 1217 1214 #endif 1218 ! of #ifdef CPP_PARA1219 END -
LMDZ6/trunk/libf/dynphy_lonlat/lmdz_gr_dyn_fi_p.F90
r5065 r5066 1 !2 ! $Id$3 !4 SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)5 1 #ifdef CPP_PARA 6 ! Interface with parallel physics, 7 USE mod_interface_dyn_phys 8 USE dimphy 9 USE parallel_lmdz 10 IMPLICIT NONE 11 c======================================================================= 12 c passage d'un champ de la grille scalaire a la grille physique 13 c======================================================================= 2 MODULE lmdz_gr_dyn_fi_p 3 IMPLICIT NONE 4 PRIVATE 5 PUBLIC gr_dyn_fi_p 6 CONTAINS 14 7 15 c----------------------------------------------------------------------- 16 c declarations: 17 c ------------- 8 SUBROUTINE gr_dyn_fi_p(nfield, im, jm, ngrid, pdyn, pfi) 9 ! Interface with parallel physics, 10 USE mod_interface_dyn_phys 11 USE dimphy 12 USE parallel_lmdz 13 !======================================================================= 14 ! passage d'un champ de la grille scalaire a la grille physique 15 !======================================================================= 18 16 19 INTEGER im,jm,ngrid,nfield 20 REAL pdyn(im,jm,nfield) 21 REAL pfi(ngrid,nfield) 17 INTEGER im, jm, ngrid, nfield 18 REAL pdyn(im, jm, nfield) 19 REAL pfi(ngrid, nfield) 20 INTEGER i, j, ig, l 22 21 23 INTEGER i,j,ig,l 22 ! IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim' 23 ! traitement des poles 24 ! traitement des point normaux 25 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 26 DO l=1,nfield 27 DO ig=1,klon 28 i=index_i(ig) 29 j=index_j(ig) 30 pfi(ig,l)=pdyn(i,j,l) 31 ENDDO 32 ENDDO 33 !$OMP END DO NOWAIT 34 END SUBROUTINE gr_dyn_fi_p 24 35 25 c----------------------------------------------------------------------- 26 c calcul: 27 c ------- 28 29 c IF(ngrid.NE.2+(jm-2)*(im-1)) STOP 'probleme de dim' 30 c traitement des poles 31 c traitement des point normaux 32 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 33 DO l=1,nfield 34 DO ig=1,klon 35 i=index_i(ig) 36 j=index_j(ig) 37 pfi(ig,l)=pdyn(i,j,l) 38 ENDDO 39 ENDDO 40 c$OMP END DO NOWAIT 36 END MODULE lmdz_gr_dyn_fi_p 41 37 #endif 42 ! of #ifdef CPP_PARA43 RETURN44 END -
LMDZ6/trunk/libf/dynphy_lonlat/lmdz_gr_fi_dyn_p.F90
r5065 r5066 1 !2 ! $Id$3 !4 SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)5 1 #ifdef CPP_PARA 6 ! Interface with parallel physics, 7 USE mod_interface_dyn_phys 8 USE dimphy 9 USE parallel_lmdz 10 IMPLICIT NONE 11 c======================================================================= 12 c passage d'un champ de la grille scalaire a la grille physique 13 c======================================================================= 2 MODULE lmdz_gr_fi_dyn_p 3 IMPLICIT NONE 4 PRIVATE 5 PUBLIC gr_fi_dyn_p 6 CONTAINS 14 7 15 c----------------------------------------------------------------------- 16 c declarations: 17 c ------------- 8 SUBROUTINE gr_fi_dyn_p(nfield, ngrid, im, jm, pfi, pdyn) 9 ! Interface with parallel physics, 10 USE mod_interface_dyn_phys 11 USE dimphy 12 USE parallel_lmdz 13 IMPLICIT NONE 14 !======================================================================= 15 ! passage d'un champ de la grille scalaire a la grille physique 16 !======================================================================= 17 INTEGER im, jm, ngrid, nfield 18 REAL pdyn(im, jm, nfield) 19 REAL pfi(ngrid, nfield) 20 INTEGER i, j, ifield, ig 18 21 19 INTEGER im,jm,ngrid,nfield 20 REAL pdyn(im,jm,nfield) 21 REAL pfi(ngrid,nfield) 22 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 23 DO ifield=1,nfield 22 24 23 INTEGER i,j,ifield,ig 25 DO ig=1,klon 26 i=index_i(ig) 27 j=index_j(ig) 28 pdyn(i,j,ifield)=pfi(ig,ifield) 29 if (i==1) pdyn(im,j,ifield)=pdyn(i,j,ifield) 30 ENDDO 24 31 25 c----------------------------------------------------------------------- 26 c calcul: 27 c ------- 28 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 29 DO ifield=1,nfield 32 ! traitement des poles 33 IF (pole_nord) THEN 34 DO i=1,im 35 pdyn(i,1,ifield)=pdyn(1,1,ifield) 36 ENDDO 37 ENDIF 38 39 IF (pole_sud) THEN 40 DO i=1,im 41 pdyn(i,jm,ifield)=pdyn(1,jm,ifield) 42 ENDDO 43 ENDIF 44 45 ENDDO 46 !$OMP END DO NOWAIT 47 END 30 48 31 do ig=1,klon 32 i=index_i(ig) 33 j=index_j(ig) 34 pdyn(i,j,ifield)=pfi(ig,ifield) 35 if (i==1) pdyn(im,j,ifield)=pdyn(i,j,ifield) 36 enddo 37 38 c traitement des poles 39 if (pole_nord) then 40 do i=1,im 41 pdyn(i,1,ifield)=pdyn(1,1,ifield) 42 enddo 43 endif 44 45 if (pole_sud) then 46 do i=1,im 47 pdyn(i,jm,ifield)=pdyn(1,jm,ifield) 48 enddo 49 endif 50 51 ENDDO 52 c$OMP END DO NOWAIT 49 END MODULE lmdz_gr_fi_dyn_p 53 50 #endif 54 ! of #ifdef CPP_PARA55 RETURN56 END -
LMDZ6/trunk/libf/misc/lmdz_xios.F90
r4619 r5066 12 12 MODULE lmdz_xios 13 13 !!!! Wrapper XIOS 14 !! => must be replaced lat ter by official xios wrapper when available14 !! => must be replaced later by official xios wrapper when available 15 15 16 16 LOGICAL,PARAMETER :: using_xios = .FALSE. -
LMDZ6/trunk/libf/obsolete/wstats.F90
r2321 r5066 294 294 ! The number of dimensions 'nbdim' of the variable, as well as the IDs of 295 295 ! corresponding dimensions must be set (in array 'dimids'). 296 ! Upon successful ldefinition of the variable, 'nvarid' contains the296 ! Upon successful definition of the variable, 'nvarid' contains the 297 297 ! NetCDF ID of the variable. 298 298 ! The variables' attributes 'title' (Note that 'long_name' would be more -
LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90
r5056 r5066 352 352 !$OMP THREADPRIVATE(d_deltat_vdf, d_deltaq_vdf) 353 353 !!! REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: d_s_vdf, d_dens_vdf 354 !!! OMP THREADPRIVATE(d_s_vdf, d_dens_vdf)354 !!!$OMP THREADPRIVATE(d_s_vdf, d_dens_vdf) 355 355 REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: d_deltat_the, d_deltaq_the 356 356 !$OMP THREADPRIVATE(d_deltat_the, d_deltaq_the) 357 357 !!! REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: d_s_the, d_dens_the 358 !!! OMP THREADPRIVATE(d_s_the, d_dens_the)358 !!!$OMP THREADPRIVATE(d_s_the, d_dens_the) 359 359 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: d_deltat_ajs_cv, d_deltaq_ajs_cv 360 360 !$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv) -
LMDZ6/trunk/libf/phylmd/physiq_mod.F90
r5050 r5066 1250 1250 !lwoff=y : offset LW CRE for radiation code and other schemes 1251 1251 REAL, SAVE :: betalwoff 1252 ! OMP THREADPRIVATE(betalwoff)1252 !$OMP THREADPRIVATE(betalwoff) 1253 1253 ! 1254 1254 INTEGER :: nbtr_tmp ! Number of tracer inside concvl -
LMDZ6/trunk/libf/phylmdiso/phys_local_var_mod.F90
r5050 r5066 351 351 !$OMP THREADPRIVATE(d_deltat_vdf, d_deltaq_vdf) 352 352 !!! REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: d_s_vdf, d_dens_vdf 353 !!! OMP THREADPRIVATE(d_s_vdf, d_dens_vdf)353 !!!$OMP THREADPRIVATE(d_s_vdf, d_dens_vdf) 354 354 REAL, SAVE, ALLOCATABLE,DIMENSION(:,:) :: d_deltat_the, d_deltaq_the 355 355 !$OMP THREADPRIVATE(d_deltat_the, d_deltaq_the) 356 356 !!! REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: d_s_the, d_dens_the 357 !!! OMP THREADPRIVATE(d_s_the, d_dens_the)357 !!!$OMP THREADPRIVATE(d_s_the, d_dens_the) 358 358 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: d_deltat_ajs_cv, d_deltaq_ajs_cv 359 359 !$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv) -
LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90
r5050 r5066 1355 1355 !lwoff=y : offset LW CRE for radiation code and other schemes 1356 1356 REAL, SAVE :: betalwoff 1357 ! OMP THREADPRIVATE(betalwoff)1357 !$OMP THREADPRIVATE(betalwoff) 1358 1358 ! 1359 1359 INTEGER :: nbtr_tmp ! Number of tracer inside concvl
Note: See TracChangeset
for help on using the changeset viewer.
