Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F90 (moved) (moved from LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F90
r5245 r5246 1 ! 1 ! 2 2 ! $Id$ 3 3 ! 4 c 5 c 4 ! 5 ! 6 6 #define DEBUG_IO 7 7 #undef DEBUG_IO 8 8 9 9 10 SUBROUTINE leapfrog_loc(ucov0,vcov0,teta0,ps0, 11 &masse0,phis0,q0,time_0)12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 USE leapfrog_mod, ONLY : ucov,vcov,teta,ps,masse,phis,q,dq32 & ,ucovm1,vcovm1,tetam1,massem1,psm1,p,pks,pk,pkf,flxw33 & ,pbaru,pbarv,du,dv,dteta,phi,dp,w34 &,leapfrog_allocate,leapfrog_switch_caldyn,leapfrog_switch_dissip35 36 37 38 39 40 USE logic_mod, ONLY: iflag_phys,ok_guide,forward,leapf,apphys,41 &statcl,conser,apdiss,purmats,ok_strato42 USE temps_mod, ONLY: itaufin,jD_ref,jH_ref,day_ini,43 &day_ref,start_time,dt44 45 USE lmdz_xios, ONLY: xios_update_calendar,46 & xios_set_current_context,47 &using_xios48 49 50 51 c...... Version du 10/01/98 ..........52 53 c avec coordonnees verticales hybrides 54 cavec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )55 56 c=======================================================================57 c 58 cAuteur: P. Le Van /L. Fairhead/F.Hourdin59 c-------60 c 61 cObjet:62 c------63 c 64 cGCM LMD nouvelle grille65 c 66 c=======================================================================67 c 68 c... Dans inigeom , nouveaux calculs pour les elongations cu , cv69 cet possibilite d'appeler une fonction f(y) a derivee tangente70 chyperbolique a la place de la fonction a derivee sinusoidale.71 72 c... Possibilite de choisir le shema pour l'advection de73 cq , en modifiant iadv dans traceur.def (10/02) .74 c 75 cPour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)76 c Pour Van-Leer iadv=10 77 c 78 c-----------------------------------------------------------------------79 cDeclarations:80 c-------------81 82 83 84 85 86 87 88 89 90 91 92 cdynamical variables:93 94 95 96 97 98 99 100 101 realzqmin,zqmax102 103 !REAL,SAVE,ALLOCATABLE :: p (:,: ) ! pression aux interfac.des couches104 !REAL,SAVE,ALLOCATABLE :: pks(:) ! exner au sol105 !REAL,SAVE,ALLOCATABLE :: pk(:,:) ! exner au milieu des couches106 !REAL,SAVE,ALLOCATABLE :: pkf(:,:) ! exner filt.au milieu des couches107 !REAL,SAVE,ALLOCATABLE :: phi(:,:) ! geopotentiel108 !REAL,SAVE,ALLOCATABLE :: w(:,:) ! vitesse verticale109 110 cvariables dynamiques intermediaire pour le transport111 !REAL,SAVE,ALLOCATABLE :: pbaru(:,:),pbarv(:,:) !flux de masse112 113 cvariables dynamiques au pas -1114 !REAL,SAVE,ALLOCATABLE :: vcovm1(:,:),ucovm1(:,:)115 ! REAL,SAVE,ALLOCATABLE :: tetam1(:,:),psm1(:)116 !REAL,SAVE,ALLOCATABLE :: massem1(:,:)117 118 ctendances dynamiques119 !REAL,SAVE,ALLOCATABLE :: dv(:,:),du(:,:)120 !REAL,SAVE,ALLOCATABLE :: dteta(:,:),dp(:)121 !REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq122 123 ctendances de la dissipation124 !REAL,SAVE,ALLOCATABLE :: dvdis(:,:),dudis(:,:)125 !REAL,SAVE,ALLOCATABLE :: dtetadis(:,:)126 127 ctendances physiques128 129 130 131 132 133 cvariables pour le fichier histoire134 REALdtav ! intervalle de temps elementaire135 136 REALtppn(iim),tpps(iim),tpn,tps137 c 138 INTEGERitau,itaufinp1,iav139 !INTEGER iday ! jour julien140 REAL time141 142 REAL SSUM143 !REAL,SAVE,ALLOCATABLE :: finvmaold(:,:)144 145 cym LOGICAL lafin146 147 INTEGERij,iq,l148 INTEGERik149 150 realtime_step, t_wrt, t_ops151 152 ! jD_cur: jour julien courant153 ! jH_cur: heure julienne courante154 155 156 157 158 159 LOGICALfirst,callinigrads160 161 162 character*10string10163 164 !REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale165 166 c+jld variables test conservation energie167 !REAL,SAVE,ALLOCATABLE :: ecin(:,:),ecin0(:,:)168 C Tendance de la temp. potentiel d (theta)/ d t due a la 169 Ctansformation d'energie cinetique en energie thermique170 Ccree par la dissipation171 !REAL,SAVE,ALLOCATABLE :: dtetaecdt(:,:)172 !REAL,SAVE,ALLOCATABLE :: vcont(:,:),ucont(:,:)173 !REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)174 REALd_h_vcol, d_qt, d_qw, d_ql, d_ec175 CHARACTER*15ztit176 !! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag.177 !SAVE ip_ebil_dyn178 !DATA ip_ebil_dyn/0/179 c-jld 180 181 character*80dynhist_file, dynhistave_file182 183 character*80abort_message184 185 186 187 188 INTEGERtestita189 190 191 192 193 cdeclaration liees au parallelisme194 195 196 197 198 199 200 201 202 203 204 205 !INTEGER :: var_time206 207 208 209 210 211 212 c$OMP MASTER213 214 c$OMP END MASTER 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 !iday = day_ini+itau/day_step248 !time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0249 !IF(time.GT.1.) THEN250 !time = time-1.251 !iday = iday+1252 !ENDIF253 254 cAllocate variables depending on dynamic variable nqtot255 !$OMP MASTER 256 257 ! 258 !ALLOCATE(p(ijb_u:ije_u,llmp1))259 ! ALLOCATE(pks(ijb_u:ije_u))260 !ALLOCATE(pk(ijb_u:ije_u,llm))261 !ALLOCATE(pkf(ijb_u:ije_u,llm))262 !ALLOCATE(phi(ijb_u:ije_u,llm))263 !ALLOCATE(w(ijb_u:ije_u,llm))264 !ALLOCATE(pbaru(ip1jmp1,llm),pbarv(ip1jm,llm))265 !ALLOCATE(vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm))266 !ALLOCATE(tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u))267 !ALLOCATE(massem1(ijb_u:ije_u,llm))268 !ALLOCATE(dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm))269 ! ALLOCATE(dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u)) 270 !ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm))271 !ALLOCATE(dtetadis(ijb_u:ije_u,llm))272 273 274 275 !ALLOCATE(dq(ijb_u:ije_u,llm,nqtot))276 277 !ALLOCATE(dqfi_tmp(iip1,llm,nqtot))278 !ALLOCATE(finvmaold(ijb_u:ije_u,llm))279 !ALLOCATE(flxw(ijb_u:ije_u,llm))280 !ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm))281 !ALLOCATE(dtetaecdt(ijb_u:ije_u,llm))282 !ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm))283 !ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm))284 285 !$OMP END MASTER 286 !$OMP BARRIER 287 288 !CALL dynredem1_loc("restart.nc",0.0,289 !& vcov,ucov,teta,q,masse,ps)290 291 292 c-----------------------------------------------------------------------293 cOn initialise la pression et la fonction d'Exner :294 c--------------------------------------------------295 296 c$OMP MASTER297 298 299 c$OMP END MASTER300 301 302 else303 304 305 c-----------------------------------------------------------------------306 cDebut de l'integration temporelle:307 c----------------------------------308 cet du parallelisme !!309 310 1 CONTINUE ! Matsuno Forward step begins here311 312 cdate: (NB: date remains unchanged for Backward step)313 c-----314 315 316 &(itau+1)/day_step317 318 & mod(itau+1,day_step)/float(day_step)319 320 321 322 323 324 10 SUBROUTINE leapfrog_loc(ucov0,vcov0,teta0,ps0, & 11 masse0,phis0,q0,time_0) 12 13 USE misc_mod 14 USE parallel_lmdz 15 USE times 16 USE mod_hallo 17 USE Bands 18 USE Write_Field 19 USE Write_Field_p 20 USE vampir 21 USE timer_filtre, ONLY : print_filtre_timer 22 USE infotrac 23 USE guide_loc_mod, ONLY : guide_main 24 USE getparam 25 USE control_mod 26 USE mod_filtreg_p 27 USE write_field_loc 28 USE allocate_field_mod 29 USE call_dissip_mod, ONLY : call_dissip 30 USE call_calfis_mod, ONLY : call_calfis 31 USE leapfrog_mod, ONLY : ucov,vcov,teta,ps,masse,phis,q,dq & 32 ,ucovm1,vcovm1,tetam1,massem1,psm1,p,pks,pk,pkf,flxw & 33 ,pbaru,pbarv,du,dv,dteta,phi,dp,w & 34 ,leapfrog_allocate,leapfrog_switch_caldyn,leapfrog_switch_dissip 35 36 use exner_hyb_loc_m, only: exner_hyb_loc 37 use exner_milieu_loc_m, only: exner_milieu_loc 38 USE comconst_mod, ONLY: cpp, dtvr, ihf 39 USE comvert_mod, ONLY: ap, bp, pressure_exner 40 USE logic_mod, ONLY: iflag_phys,ok_guide,forward,leapf,apphys, & 41 statcl,conser,apdiss,purmats,ok_strato 42 USE temps_mod, ONLY: itaufin,jD_ref,jH_ref,day_ini, & 43 day_ref,start_time,dt 44 USE mod_xios_dyn3dmem, ONLY : dyn3d_ctx_handle 45 USE lmdz_xios, ONLY: xios_update_calendar, & 46 xios_set_current_context, & 47 using_xios 48 49 IMPLICIT NONE 50 51 ! ...... Version du 10/01/98 .......... 52 53 ! avec coordonnees verticales hybrides 54 ! avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 ) 55 56 !======================================================================= 57 ! 58 ! Auteur: P. Le Van /L. Fairhead/F.Hourdin 59 ! ------- 60 ! 61 ! Objet: 62 ! ------ 63 ! 64 ! GCM LMD nouvelle grille 65 ! 66 !======================================================================= 67 ! 68 ! ... Dans inigeom , nouveaux calculs pour les elongations cu , cv 69 ! et possibilite d'appeler une fonction f(y) a derivee tangente 70 ! hyperbolique a la place de la fonction a derivee sinusoidale. 71 72 ! ... Possibilite de choisir le shema pour l'advection de 73 ! q , en modifiant iadv dans traceur.def (10/02) . 74 ! 75 ! Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99) 76 ! Pour Van-Leer iadv=10 77 ! 78 !----------------------------------------------------------------------- 79 ! Declarations: 80 ! ------------- 81 82 include "dimensions.h" 83 include "paramet.h" 84 include "comdissnew.h" 85 include "comgeom.h" 86 include "description.h" 87 include "iniprint.h" 88 include "academic.h" 89 90 REAL,INTENT(IN) :: time_0 ! not used 91 92 ! dynamical variables: 93 REAL,INTENT(IN) :: ucov0(ijb_u:ije_u,llm) ! zonal covariant wind 94 REAL,INTENT(IN) :: vcov0(ijb_v:ije_v,llm) ! meridional covariant wind 95 REAL,INTENT(IN) :: teta0(ijb_u:ije_u,llm) ! potential temperature 96 REAL,INTENT(IN) :: q0(ijb_u:ije_u,llm,nqtot) ! advected tracers 97 REAL,INTENT(IN) :: ps0(ijb_u:ije_u) ! surface pressure (Pa) 98 REAL,INTENT(IN) :: masse0(ijb_u:ije_u,llm) ! air mass 99 REAL,INTENT(IN) :: phis0(ijb_u:ije_u) ! geopotentiat at the surface 100 101 real :: zqmin,zqmax 102 103 ! REAL,SAVE,ALLOCATABLE :: p (:,: ) ! pression aux interfac.des couches 104 ! REAL,SAVE,ALLOCATABLE :: pks(:) ! exner au sol 105 ! REAL,SAVE,ALLOCATABLE :: pk(:,:) ! exner au milieu des couches 106 ! REAL,SAVE,ALLOCATABLE :: pkf(:,:) ! exner filt.au milieu des couches 107 ! REAL,SAVE,ALLOCATABLE :: phi(:,:) ! geopotentiel 108 ! REAL,SAVE,ALLOCATABLE :: w(:,:) ! vitesse verticale 109 110 ! variables dynamiques intermediaire pour le transport 111 ! REAL,SAVE,ALLOCATABLE :: pbaru(:,:),pbarv(:,:) !flux de masse 112 113 ! variables dynamiques au pas -1 114 ! REAL,SAVE,ALLOCATABLE :: vcovm1(:,:),ucovm1(:,:) 115 ! REAL,SAVE,ALLOCATABLE :: tetam1(:,:),psm1(:) 116 ! REAL,SAVE,ALLOCATABLE :: massem1(:,:) 117 118 ! tendances dynamiques 119 ! REAL,SAVE,ALLOCATABLE :: dv(:,:),du(:,:) 120 ! REAL,SAVE,ALLOCATABLE :: dteta(:,:),dp(:) 121 ! REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq 122 123 ! tendances de la dissipation 124 ! REAL,SAVE,ALLOCATABLE :: dvdis(:,:),dudis(:,:) 125 ! REAL,SAVE,ALLOCATABLE :: dtetadis(:,:) 126 127 ! tendances physiques 128 REAL,SAVE,ALLOCATABLE :: dvfi(:,:),dufi(:,:) 129 REAL,SAVE,ALLOCATABLE :: dtetafi(:,:) 130 REAL,SAVE,ALLOCATABLE :: dpfi(:) 131 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi 132 133 ! variables pour le fichier histoire 134 REAL :: dtav ! intervalle de temps elementaire 135 136 REAL :: tppn(iim),tpps(iim),tpn,tps 137 ! 138 INTEGER :: itau,itaufinp1,iav 139 ! INTEGER iday ! jour julien 140 REAL :: time 141 142 REAL :: SSUM 143 ! REAL,SAVE,ALLOCATABLE :: finvmaold(:,:) 144 145 !ym LOGICAL lafin 146 LOGICAL :: lafin 147 INTEGER :: ij,iq,l 148 INTEGER :: ik 149 150 real :: time_step, t_wrt, t_ops 151 152 ! jD_cur: jour julien courant 153 ! jH_cur: heure julienne courante 154 REAL :: jD_cur, jH_cur 155 INTEGER :: an, mois, jour 156 REAL :: secondes 157 158 logical :: physic 159 LOGICAL :: first,callinigrads 160 161 data callinigrads/.true./ 162 character(len=10) :: string10 163 164 ! REAL,SAVE,ALLOCATABLE :: flxw(:,:) ! flux de masse verticale 165 166 !+jld variables test conservation energie 167 ! REAL,SAVE,ALLOCATABLE :: ecin(:,:),ecin0(:,:) 168 ! Tendance de la temp. potentiel d (theta)/ d t due a la 169 ! tansformation d'energie cinetique en energie thermique 170 ! cree par la dissipation 171 ! REAL,SAVE,ALLOCATABLE :: dtetaecdt(:,:) 172 ! REAL,SAVE,ALLOCATABLE :: vcont(:,:),ucont(:,:) 173 ! REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:) 174 REAL :: d_h_vcol, d_qt, d_qw, d_ql, d_ec 175 CHARACTER(len=15) :: ztit 176 !! INTEGER ip_ebil_dyn ! PRINT level for energy conserv. diag. 177 ! SAVE ip_ebil_dyn 178 ! DATA ip_ebil_dyn/0/ 179 !-jld 180 181 character(len=80) :: dynhist_file, dynhistave_file 182 character(len=*),parameter :: modname="leapfrog_loc" 183 character(len=80) :: abort_message 184 185 186 logical,PARAMETER :: dissip_conservative=.TRUE. 187 188 INTEGER :: testita 189 PARAMETER (testita = 9) 190 191 logical , parameter :: flag_verif = .false. 192 193 ! declaration liees au parallelisme 194 INTEGER :: ierr 195 LOGICAL :: FirstCaldyn 196 LOGICAL :: FirstPhysic 197 INTEGER :: ijb,ije,j,i 198 type(Request) :: TestRequest 199 type(Request) :: Request_Dissip 200 type(Request) :: Request_physic 201 202 INTEGER :: true_itau 203 INTEGER :: iapptrac 204 INTEGER :: AdjustCount 205 ! INTEGER :: var_time 206 LOGICAL :: ok_start_timer=.FALSE. 207 LOGICAL, SAVE :: firstcall=.TRUE. 208 TYPE(distrib),SAVE :: new_dist 209 210 call check_isotopes(q0,ijb_u,ije_u,'leapfrog204: debut') 211 212 !$OMP MASTER 213 ItCount=0 214 !$OMP END MASTER 215 true_itau=0 216 FirstCaldyn=.TRUE. 217 FirstPhysic=.TRUE. 218 iapptrac=0 219 AdjustCount = 0 220 lafin=.false. 221 222 if (nday>=0) then 223 itaufin = nday*day_step 224 else 225 itaufin = -nday 226 endif 227 228 itaufinp1 = itaufin +1 229 230 call check_isotopes(q0,ijb_u,ije_u,'leapfrog 226') 231 232 itau = 0 233 physic=.true. 234 if (iflag_phys==0.or.iflag_phys==2) physic=.false. 235 CALL init_nan 236 CALL leapfrog_allocate 237 ucov=ucov0 238 vcov=vcov0 239 teta=teta0 240 ps=ps0 241 masse=masse0 242 phis=phis0 243 q=q0 244 245 call check_isotopes(q,ijb_u,ije_u,'leapfrog 239') 246 247 ! iday = day_ini+itau/day_step 248 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 249 ! IF(time.GT.1.) THEN 250 ! time = time-1. 251 ! iday = iday+1 252 ! ENDIF 253 254 ! Allocate variables depending on dynamic variable nqtot 255 !$OMP MASTER 256 if (firstcall) then 257 ! 258 ! ALLOCATE(p(ijb_u:ije_u,llmp1)) 259 ! ALLOCATE(pks(ijb_u:ije_u)) 260 ! ALLOCATE(pk(ijb_u:ije_u,llm)) 261 ! ALLOCATE(pkf(ijb_u:ije_u,llm)) 262 ! ALLOCATE(phi(ijb_u:ije_u,llm)) 263 ! ALLOCATE(w(ijb_u:ije_u,llm)) 264 ! ALLOCATE(pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)) 265 ! ALLOCATE(vcovm1(ijb_v:ije_v,llm),ucovm1(ijb_u:ije_u,llm)) 266 ! ALLOCATE(tetam1(ijb_u:ije_u,llm),psm1(ijb_u:ije_u)) 267 ! ALLOCATE(massem1(ijb_u:ije_u,llm)) 268 ! ALLOCATE(dv(ijb_v:ije_v,llm),du(ijb_u:ije_u,llm)) 269 ! ALLOCATE(dteta(ijb_u:ije_u,llm),dp(ijb_u:ije_u)) 270 ! ALLOCATE(dvdis(ijb_v:ije_v,llm),dudis(ijb_u:ije_u,llm)) 271 ! ALLOCATE(dtetadis(ijb_u:ije_u,llm)) 272 ALLOCATE(dvfi(ijb_v:ije_v,llm),dufi(ijb_u:ije_u,llm)) 273 ALLOCATE(dtetafi(ijb_u:ije_u,llm)) 274 ALLOCATE(dpfi(ijb_u:ije_u)) 275 ! ALLOCATE(dq(ijb_u:ije_u,llm,nqtot)) 276 ALLOCATE(dqfi(ijb_u:ije_u,llm,nqtot)) 277 ! ALLOCATE(dqfi_tmp(iip1,llm,nqtot)) 278 ! ALLOCATE(finvmaold(ijb_u:ije_u,llm)) 279 ! ALLOCATE(flxw(ijb_u:ije_u,llm)) 280 ! ALLOCATE(ecin(ijb_u:ije_u,llm),ecin0(ijb_u:ije_u,llm)) 281 ! ALLOCATE(dtetaecdt(ijb_u:ije_u,llm)) 282 ! ALLOCATE(vcont(ijb_v:ije_v,llm),ucont(ijb_u:ije_u,llm)) 283 ! ALLOCATE(vnat(ijb_v:ije_v,llm),unat(ijb_u:ije_u,llm)) 284 endif 285 !$OMP END MASTER 286 !$OMP BARRIER 287 288 ! CALL dynredem1_loc("restart.nc",0.0, 289 ! & vcov,ucov,teta,q,masse,ps) 290 291 292 !----------------------------------------------------------------------- 293 ! On initialise la pression et la fonction d'Exner : 294 ! -------------------------------------------------- 295 296 !$OMP MASTER 297 dq(:,:,:)=0. 298 CALL pression ( ijnb_u, ap, bp, ps, p ) 299 !$OMP END MASTER 300 if (pressure_exner) then 301 CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf) 302 else 303 CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf ) 304 endif 305 !----------------------------------------------------------------------- 306 ! Debut de l'integration temporelle: 307 ! ---------------------------------- 308 ! et du parallelisme !! 309 310 1 CONTINUE ! Matsuno Forward step begins here 311 312 ! date: (NB: date remains unchanged for Backward step) 313 ! ----- 314 315 jD_cur = jD_ref + day_ini - day_ref + & 316 (itau+1)/day_step 317 jH_cur = jH_ref + start_time + & 318 mod(itau+1,day_step)/float(day_step) 319 if (jH_cur > 1.0 ) then 320 jD_cur = jD_cur +1. 321 jH_cur = jH_cur -1. 322 endif 323 324 call check_isotopes(q,ijb_u,ije_u,'leapfrog 321') 325 325 326 326 #ifdef CPP_IOIPSL 327 328 329 !$OMP BARRIER 330 327 if (ok_guide) then 328 call guide_main(itau,ucov,vcov,teta,q,masse,ps) 329 !$OMP BARRIER 330 endif 331 331 #endif 332 332 333 333 334 c 335 c IF( MOD( itau, 10* day_step ).EQ.0 ) THEN 336 c CALL test_period ( ucov,vcov,teta,q,p,phis ) 337 c PRINT *,' ---- Test_period apres continue OK ! -----', itau 338 c ENDIF 339 c 340 cym CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 ) 341 cym CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 ) 342 cym CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 ) 343 cym CALL SCOPY( ijp1llm,masse, 1, massem1, 1 ) 344 cym CALL SCOPY( ip1jmp1, ps , 1, psm1 , 1 ) 345 346 if (FirstCaldyn) then 347 c$OMP MASTER 348 ucovm1=ucov 349 vcovm1=vcov 350 tetam1= teta 351 massem1= masse 352 psm1= ps 353 354 ! Ehouarn: finvmaold is actually not used 355 ! finvmaold = masse 356 c$OMP END MASTER 357 c$OMP BARRIER 358 ! CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm, 359 ! & -2,2, .TRUE., 1 ) 360 else 361 ! Save fields obtained at previous time step as '...m1' 362 ijb=ij_begin 363 ije=ij_end 364 365 c$OMP MASTER 366 psm1 (ijb:ije) = ps (ijb:ije) 367 c$OMP END MASTER 368 369 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 370 DO l=1,llm 371 ije=ij_end 372 ucovm1 (ijb:ije,l) = ucov (ijb:ije,l) 373 tetam1 (ijb:ije,l) = teta (ijb:ije,l) 374 massem1 (ijb:ije,l) = masse (ijb:ije,l) 375 ! finvmaold(ijb:ije,l)=masse(ijb:ije,l) 376 377 if (pole_sud) ije=ij_end-iip1 378 vcovm1(ijb:ije,l) = vcov (ijb:ije,l) 379 380 381 ENDDO 382 c$OMP ENDDO 383 384 385 ! Ehouarn: finvmaold not used 386 ! CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1, 387 ! . llm, -2,2, .TRUE., 1 ) 388 389 endif ! of if (FirstCaldyn) 390 391 forward = .TRUE. 392 leapf = .FALSE. 393 dt = dtvr 394 395 c ... P.Le Van .26/04/94 .... 396 397 cym CALL SCOPY ( ijp1llm, masse, 1, finvmaold, 1 ) 398 cym CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 ) 399 400 cym ne sert a rien 401 cym call minmax(ijp1llm,q(:,:,3),zqmin,zqmax) 402 403 404 call check_isotopes(q,ijb_u,ije_u,'leapfrog 400') 405 406 2 CONTINUE ! Matsuno backward or leapfrog step begins here 407 408 409 call check_isotopes(q,ijb_u,ije_u,'leapfrog 402') 410 411 c$OMP MASTER 412 ItCount=ItCount+1 413 if (MOD(ItCount,1)==1) then 414 debug=.true. 415 else 416 debug=.false. 417 endif 418 c$OMP END MASTER 419 c----------------------------------------------------------------------- 420 421 c date: (NB: only leapfrog step requires recomputing date) 422 c ----- 423 424 IF (leapf) THEN 425 jD_cur = jD_ref + day_ini - day_ref + 426 & (itau+1)/day_step 427 jH_cur = jH_ref + start_time + 428 & mod(itau+1,day_step)/float(day_step) 429 if (jH_cur > 1.0 ) then 430 jD_cur = jD_cur +1. 431 jH_cur = jH_cur -1. 432 endif 433 ENDIF 434 435 c gestion des appels de la physique et des dissipations: 436 c ------------------------------------------------------ 437 c 438 c ... P.Le Van ( 6/02/95 ) .... 439 440 apphys = .FALSE. 441 statcl = .FALSE. 442 conser = .FALSE. 443 apdiss = .FALSE. 444 445 IF( purmats ) THEN 446 ! Purely Matsuno time stepping 447 IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE. 448 IF( MOD(itau,dissip_period ).EQ.0.AND..NOT.forward ) 449 s apdiss = .TRUE. 450 IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward 451 s .and. physic ) apphys = .TRUE. 452 ELSE 453 ! Leapfrog/Matsuno time stepping 454 IF( MOD(itau ,iconser) .EQ. 0 ) conser = .TRUE. 455 IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward ) 456 s apdiss = .TRUE. 457 IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE. 458 END IF 459 460 ! Ehouarn: for Shallow Water case (ie: 1 vertical layer), 461 ! supress dissipation step 462 if (llm.eq.1) then 463 apdiss=.false. 464 endif 465 466 cym ---> Pour le moment 467 cym apphys = .FALSE. 468 statcl = .FALSE. 469 ! conser = .FALSE. ! ie: no output of control variables to stdout in // 470 471 if (firstCaldyn) then 472 c$OMP MASTER 473 call Set_Distrib(distrib_caldyn) 474 c$OMP END MASTER 475 c$OMP BARRIER 476 firstCaldyn=.FALSE. 477 cym call InitTime 478 c$OMP MASTER 479 call Init_timer 480 c$OMP END MASTER 481 endif 482 483 c$OMP MASTER 484 IF (ok_start_timer) THEN 485 CALL InitTime 486 ok_start_timer=.FALSE. 487 ENDIF 488 c$OMP END MASTER 489 490 491 call check_isotopes(q,ijb_u,ije_u,'leapfrog 471') 492 493 !ym PAS D'AJUSTEMENT POUR LE MOMENT 494 if (Adjust) then 495 AdjustCount=AdjustCount+1 496 ! if (iapptrac==iapp_tracvl .and. (forward. OR . leapf) 497 ! & .and. itau/iphysiq>2 .and. Adjustcount>30) then 498 if (Adjustcount>1) then 499 AdjustCount=0 500 c$OMP MASTER 501 call allgather_timer_average 502 503 if (prt_level > 9) then 504 334 ! 335 ! IF( MOD( itau, 10* day_step ).EQ.0 ) THEN 336 ! CALL test_period ( ucov,vcov,teta,q,p,phis ) 337 ! PRINT *,' ---- Test_period apres continue OK ! -----', itau 338 ! ENDIF 339 ! 340 !ym CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 ) 341 !ym CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 ) 342 !ym CALL SCOPY( ijp1llm,teta , 1, tetam1 , 1 ) 343 !ym CALL SCOPY( ijp1llm,masse, 1, massem1, 1 ) 344 !ym CALL SCOPY( ip1jmp1, ps , 1, psm1 , 1 ) 345 346 if (FirstCaldyn) then 347 !$OMP MASTER 348 ucovm1=ucov 349 vcovm1=vcov 350 tetam1= teta 351 massem1= masse 352 psm1= ps 353 354 ! Ehouarn: finvmaold is actually not used 355 ! finvmaold = masse 356 !$OMP END MASTER 357 !$OMP BARRIER 358 ! CALL filtreg_p ( finvmaold ,jjb_u,jje_u,jjb_u,jje_u,jjp1, llm, 359 ! & -2,2, .TRUE., 1 ) 360 else 361 ! Save fields obtained at previous time step as '...m1' 362 ijb=ij_begin 363 ije=ij_end 364 365 !$OMP MASTER 366 psm1 (ijb:ije) = ps (ijb:ije) 367 !$OMP END MASTER 368 369 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 370 DO l=1,llm 371 ije=ij_end 372 ucovm1 (ijb:ije,l) = ucov (ijb:ije,l) 373 tetam1 (ijb:ije,l) = teta (ijb:ije,l) 374 massem1 (ijb:ije,l) = masse (ijb:ije,l) 375 ! finvmaold(ijb:ije,l)=masse(ijb:ije,l) 376 377 if (pole_sud) ije=ij_end-iip1 378 vcovm1(ijb:ije,l) = vcov (ijb:ije,l) 379 380 381 ENDDO 382 !$OMP ENDDO 383 384 385 ! Ehouarn: finvmaold not used 386 ! CALL filtreg_p(finvmaold ,jjb_u,jje_u,jj_begin,jj_end,jjp1, 387 ! . llm, -2,2, .TRUE., 1 ) 388 389 endif ! of if (FirstCaldyn) 390 391 forward = .TRUE. 392 leapf = .FALSE. 393 dt = dtvr 394 395 ! ... P.Le Van .26/04/94 .... 396 397 !ym CALL SCOPY ( ijp1llm, masse, 1, finvmaold, 1 ) 398 !ym CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 ) 399 400 !ym ne sert a rien 401 !ym call minmax(ijp1llm,q(:,:,3),zqmin,zqmax) 402 403 404 call check_isotopes(q,ijb_u,ije_u,'leapfrog 400') 405 406 2 CONTINUE ! Matsuno backward or leapfrog step begins here 407 408 409 call check_isotopes(q,ijb_u,ije_u,'leapfrog 402') 410 411 !$OMP MASTER 412 ItCount=ItCount+1 413 if (MOD(ItCount,1)==1) then 414 debug=.true. 415 else 416 debug=.false. 417 endif 418 !$OMP END MASTER 419 !----------------------------------------------------------------------- 420 421 ! date: (NB: only leapfrog step requires recomputing date) 422 ! ----- 423 424 IF (leapf) THEN 425 jD_cur = jD_ref + day_ini - day_ref + & 426 (itau+1)/day_step 427 jH_cur = jH_ref + start_time + & 428 mod(itau+1,day_step)/float(day_step) 429 if (jH_cur > 1.0 ) then 430 jD_cur = jD_cur +1. 431 jH_cur = jH_cur -1. 432 endif 433 ENDIF 434 435 ! gestion des appels de la physique et des dissipations: 436 ! ------------------------------------------------------ 437 ! 438 ! ... P.Le Van ( 6/02/95 ) .... 439 440 apphys = .FALSE. 441 statcl = .FALSE. 442 conser = .FALSE. 443 apdiss = .FALSE. 444 445 IF( purmats ) THEN 446 ! ! Purely Matsuno time stepping 447 IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE. 448 IF( MOD(itau,dissip_period ).EQ.0.AND..NOT.forward ) & 449 apdiss = .TRUE. 450 IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward & 451 .and. physic ) apphys = .TRUE. 452 ELSE 453 ! ! Leapfrog/Matsuno time stepping 454 IF( MOD(itau ,iconser) .EQ. 0 ) conser = .TRUE. 455 IF( MOD(itau+1,dissip_period).EQ.0 .AND. .NOT. forward ) & 456 apdiss = .TRUE. 457 IF( MOD(itau+1,iphysiq).EQ.0.AND.physic) apphys=.TRUE. 458 END IF 459 460 ! Ehouarn: for Shallow Water case (ie: 1 vertical layer), 461 ! supress dissipation step 462 if (llm.eq.1) then 463 apdiss=.false. 464 endif 465 466 !ym ---> Pour le moment 467 !ym apphys = .FALSE. 468 statcl = .FALSE. 469 ! conser = .FALSE. ! ie: no output of control variables to stdout in // 470 471 if (firstCaldyn) then 472 !$OMP MASTER 473 call Set_Distrib(distrib_caldyn) 474 !$OMP END MASTER 475 !$OMP BARRIER 476 firstCaldyn=.FALSE. 477 !ym call InitTime 478 !$OMP MASTER 479 call Init_timer 480 !$OMP END MASTER 481 endif 482 483 !$OMP MASTER 484 IF (ok_start_timer) THEN 485 CALL InitTime 486 ok_start_timer=.FALSE. 487 ENDIF 488 !$OMP END MASTER 489 490 491 call check_isotopes(q,ijb_u,ije_u,'leapfrog 471') 492 493 !ym PAS D'AJUSTEMENT POUR LE MOMENT 494 if (Adjust) then 495 AdjustCount=AdjustCount+1 496 ! if (iapptrac==iapp_tracvl .and. (forward.OR. leapf) 497 ! & .and. itau/iphysiq>2 .and. Adjustcount>30) then 498 if (Adjustcount>1) then 499 AdjustCount=0 500 !$OMP MASTER 501 call allgather_timer_average 502 503 if (prt_level > 9) then 504 505 print *,'*********************************' 506 print *,'****** TIMER CALDYN ******' 507 do i=0,mpi_size-1 508 print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), & 509 ' : temps moyen :', & 510 timer_average(jj_nb_caldyn(i),timer_caldyn,i), & 511 '+-',timer_delta(jj_nb_caldyn(i),timer_caldyn,i) 512 enddo 513 514 print *,'*********************************' 515 print *,'****** TIMER VANLEER ******' 516 do i=0,mpi_size-1 517 print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), & 518 ' : temps moyen :', & 519 timer_average(jj_nb_vanleer(i),timer_vanleer,i), & 520 '+-',timer_delta(jj_nb_vanleer(i),timer_vanleer,i) 521 enddo 522 523 print *,'*********************************' 524 print *,'****** TIMER DISSIP ******' 525 do i=0,mpi_size-1 526 print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), & 527 ' : temps moyen :', & 528 timer_average(jj_nb_dissip(i),timer_dissip,i), & 529 '+-',timer_delta(jj_nb_dissip(i),timer_dissip,i) 530 enddo 531 532 ! if (mpi_rank==0) call WriteBands 533 534 endif 535 536 call AdjustBands_caldyn(new_dist) 537 !$OMP END MASTER 538 !$OMP BARRIER 539 CALL leapfrog_switch_caldyn(new_dist) 540 !$OMP BARRIER 541 542 543 !$OMP MASTER 544 distrib_caldyn=new_dist 545 CALL set_distrib(distrib_caldyn) 546 !$OMP END MASTER 547 !$OMP BARRIER 548 ! call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm, 549 ! & jj_Nb_caldyn,0,0,TestRequest) 550 ! call Register_SwapFieldHallo(ucovm1,ucovm1,ip1jmp1,llm, 551 ! & jj_Nb_caldyn,0,0,TestRequest) 552 ! call Register_SwapFieldHallo(vcov,vcov,ip1jm,llm, 553 ! & jj_Nb_caldyn,0,0,TestRequest) 554 ! call Register_SwapFieldHallo(vcovm1,vcovm1,ip1jm,llm, 555 ! & jj_Nb_caldyn,0,0,TestRequest) 556 ! call Register_SwapFieldHallo(teta,teta,ip1jmp1,llm, 557 ! & jj_Nb_caldyn,0,0,TestRequest) 558 ! call Register_SwapFieldHallo(tetam1,tetam1,ip1jmp1,llm, 559 ! & jj_Nb_caldyn,0,0,TestRequest) 560 ! call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm, 561 ! & jj_Nb_caldyn,0,0,TestRequest) 562 ! call Register_SwapFieldHallo(massem1,massem1,ip1jmp1,llm, 563 ! & jj_Nb_caldyn,0,0,TestRequest) 564 ! call Register_SwapFieldHallo(ps,ps,ip1jmp1,1, 565 ! & jj_Nb_caldyn,0,0,TestRequest) 566 ! call Register_SwapFieldHallo(psm1,psm1,ip1jmp1,1, 567 ! & jj_Nb_caldyn,0,0,TestRequest) 568 ! call Register_SwapFieldHallo(pkf,pkf,ip1jmp1,llm, 569 ! & jj_Nb_caldyn,0,0,TestRequest) 570 ! call Register_SwapFieldHallo(pk,pk,ip1jmp1,llm, 571 ! & jj_Nb_caldyn,0,0,TestRequest) 572 ! call Register_SwapFieldHallo(pks,pks,ip1jmp1,1, 573 ! & jj_Nb_caldyn,0,0,TestRequest) 574 ! call Register_SwapFieldHallo(phis,phis,ip1jmp1,1, 575 ! & jj_Nb_caldyn,0,0,TestRequest) 576 ! call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm, 577 ! & jj_Nb_caldyn,0,0,TestRequest) 578 ! call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm, 579 ! & jj_Nb_caldyn,0,0,TestRequest) 580 ! 581 ! do j=1,nqtot 582 ! call Register_SwapFieldHallo(q(:,:,j),q(:,:,j),ip1jmp1,llm, 583 ! & jj_nb_caldyn,0,0,TestRequest) 584 ! enddo 585 ! 586 ! call Set_Distrib(distrib_caldyn) 587 ! call SendRequest(TestRequest) 588 ! call WaitRequest(TestRequest) 589 590 !$OMP MASTER 591 call AdjustBands_dissip(new_dist) 592 !$OMP END MASTER 593 !$OMP BARRIER 594 CALL leapfrog_switch_dissip(new_dist) 595 !$OMP BARRIER 596 !$OMP MASTER 597 distrib_dissip=new_dist 598 !$OMP END MASTER 599 !$OMP BARRIER 600 ! call AdjustBands_physic 601 602 !$OMP MASTER 603 if (mpi_rank==0) call WriteBands 604 !$OMP END MASTER 605 606 607 endif 608 endif 609 610 611 call check_isotopes(q,ijb_u,ije_u,'leapfrog 589') 612 613 !----------------------------------------------------------------------- 614 ! calcul des tendances dynamiques: 615 ! -------------------------------- 616 !$OMP BARRIER 617 !$OMP MASTER 618 call VTb(VThallo) 619 !$OMP END MASTER 620 621 call Register_Hallo_u(ucov,llm,1,1,1,1,TestRequest) 622 call Register_Hallo_v(vcov,llm,1,1,1,1,TestRequest) 623 call Register_Hallo_u(teta,llm,1,1,1,1,TestRequest) 624 call Register_Hallo_u(ps,1,1,2,2,1,TestRequest) 625 call Register_Hallo_u(pkf,llm,1,1,1,1,TestRequest) 626 call Register_Hallo_u(pk,llm,1,1,1,1,TestRequest) 627 call Register_Hallo_u(pks,1,1,1,1,1,TestRequest) 628 call Register_Hallo_u(p,llmp1,1,1,1,1,TestRequest) 629 630 ! do j=1,nqtot 631 ! call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1, 632 ! * TestRequest) 633 ! enddo 634 635 call SendRequest(TestRequest) 636 !$OMP BARRIER 637 call WaitRequest(TestRequest) 638 639 !$OMP MASTER 640 call VTe(VThallo) 641 !$OMP END MASTER 642 !$OMP BARRIER 643 644 if (debug) then 645 call WriteField_u('ucov',ucov) 646 call WriteField_v('vcov',vcov) 647 call WriteField_u('teta',teta) 648 call WriteField_u('ps',ps) 649 call WriteField_u('masse',masse) 650 call WriteField_u('pk',pk) 651 call WriteField_u('pks',pks) 652 call WriteField_u('pkf',pkf) 653 call WriteField_u('phis',phis) 654 do iq=1,nqtot 655 call WriteField_u('q'//trim(int2str(iq)), & 656 q(:,:,iq)) 657 enddo 658 endif 659 660 661 True_itau=True_itau+1 662 663 !$OMP MASTER 664 IF (prt_level>9) THEN 665 WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau 666 ENDIF 667 668 669 call start_timer(timer_caldyn) 670 671 ! ! compute geopotential phi() 672 CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi ) 673 674 call check_isotopes(q,ijb_u,ije_u,'leapfrog 651') 675 676 call VTb(VTcaldyn) 677 !$OMP END MASTER 678 ! var_time=time+iday-day_ini 679 680 !$OMP BARRIER 681 ! CALL FTRACE_REGION_BEGIN("caldyn") 682 time = jD_cur + jH_cur 683 684 CALL caldyn_loc & 685 ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , & 686 phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time ) 687 688 ! CALL FTRACE_REGION_END("caldyn") 689 690 !$OMP MASTER 691 if (mpi_rank==0.AND.conser) THEN 692 WRITE(lunout,*) 'leapfrog_loc, Time step: ',itau,' Day:',time 693 ENDIF 694 call VTe(VTcaldyn) 695 !$OMP END MASTER 696 697 #ifdef DEBUG_IO 698 call WriteField_u('du',du) 699 call WriteField_v('dv',dv) 700 call WriteField_u('dteta',dteta) 701 call WriteField_u('dp',dp) 702 call WriteField_u('w',w) 703 call WriteField_u('pbaru',pbaru) 704 call WriteField_v('pbarv',pbarv) 705 call WriteField_u('p',p) 706 call WriteField_u('masse',masse) 707 call WriteField_u('pk',pk) 708 #endif 709 !----------------------------------------------------------------------- 710 ! calcul des tendances advection des traceurs (dont l'humidite) 711 ! ------------------------------------------------------------- 712 713 call check_isotopes(q,ijb_u,ije_u, & 714 'leapfrog 686: avant caladvtrac') 715 716 IF( forward.OR. leapf ) THEN 717 ! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step 718 ! !write(*,*) 'leapfrog 679: avant CALL caladvtrac_loc' 719 CALL caladvtrac_loc(q,pbaru,pbarv, & 720 p, masse, dq, teta, & 721 flxw,pk, iapptrac) 722 723 ! call creation of mass flux 724 IF (offline .AND. .NOT. adjust) THEN 725 CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi) 726 ENDIF 727 728 ! !write(*,*) 'leapfrog 719' 729 call check_isotopes(q,ijb_u,ije_u, & 730 'leapfrog 698: apres caladvtrac') 731 732 ! do j=1,nqtot 733 ! call WriteField_u('qadv'//trim(int2str(j)),q(:,:,j)) 734 ! enddo 735 736 ! Ehouarn: Storage of mass flux for off-line tracers... not implemented... 737 738 ENDIF ! of IF( forward.OR. leapf ) 739 740 741 !----------------------------------------------------------------------- 742 ! integrations dynamique et traceurs: 743 ! ---------------------------------- 744 745 !$OMP MASTER 746 call VTb(VTintegre) 747 !$OMP END MASTER 748 #ifdef DEBUG_IO 749 if (true_itau>20) then 750 call WriteField_u('ucovm1',ucovm1) 751 call WriteField_v('vcovm1',vcovm1) 752 call WriteField_u('tetam1',tetam1) 753 call WriteField_u('psm1',psm1) 754 call WriteField_u('ucov_int',ucov) 755 call WriteField_v('vcov_int',vcov) 756 call WriteField_u('teta_int',teta) 757 call WriteField_u('ps_int',ps) 758 endif 759 #endif 760 !$OMP BARRIER 761 ! CALL FTRACE_REGION_BEGIN("integrd") 762 763 ! !write(*,*) 'leapfrog 720' 764 call check_isotopes(q,ijb_u,ije_u,'leapfrog 756') 765 766 ! ! CRisi: pourquoi aller jusqu'à 2 et non pas jusqu'à nqtot?? 767 CALL integrd_loc ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 , & 768 dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis) 769 ! $ finvmaold ) 770 771 ! !write(*,*) 'leapfrog 724' 772 call check_isotopes(q,ijb_u,ije_u,'leapfrog 762') 773 774 ! CALL FTRACE_REGION_END("integrd") 775 !$OMP BARRIER 776 #ifdef DEBUG_IO 777 call WriteField_u('ucovm1',ucovm1) 778 call WriteField_v('vcovm1',vcovm1) 779 call WriteField_u('tetam1',tetam1) 780 call WriteField_u('psm1',psm1) 781 call WriteField_u('ucov_int',ucov) 782 call WriteField_v('vcov_int',vcov) 783 call WriteField_u('teta_int',teta) 784 call WriteField_u('ps_int',ps) 785 #endif 786 787 call check_isotopes(q,ijb_u,ije_u,'leapfrog 775') 788 789 ! do j=1,nqtot 790 ! call WriteField_p('q'//trim(int2str(j)), 791 ! . reshape(q(:,:,j),(/iip1,jmp1,llm/))) 792 ! call WriteField_p('dq'//trim(int2str(j)), 793 ! . reshape(dq(:,:,j),(/iip1,jmp1,llm/))) 794 ! enddo 795 796 797 !$OMP MASTER 798 call VTe(VTintegre) 799 !$OMP END MASTER 800 ! .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd) 801 ! 802 !----------------------------------------------------------------------- 803 ! calcul des tendances physiques: 804 ! ------------------------------- 805 ! ######## P.Le Van ( Modif le 6/02/95 ) ########### 806 ! 807 IF( purmats ) THEN 808 IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE. 809 ELSE 810 IF( itau+1.EQ. itaufin ) lafin = .TRUE. 811 ENDIF 812 813 !c$OMP END PARALLEL 814 815 ! 816 ! 817 IF( apphys ) THEN 818 819 CALL call_calfis(itau,lafin,ucov,vcov,teta,masse,ps, & 820 phis,q,flxw) 821 ! #ifdef DEBUG_IO 822 ! call WriteField_u('ucovfi',ucov) 823 ! call WriteField_v('vcovfi',vcov) 824 ! call WriteField_u('tetafi',teta) 825 ! call WriteField_u('pfi',p) 826 ! call WriteField_u('pkfi',pk) 827 ! do j=1,nqtot 828 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 829 ! enddo 830 ! #endif 831 ! c 832 ! c ....... Ajout P.Le Van ( 17/04/96 ) ........... 833 ! c 834 ! cc$OMP PARALLEL DEFAULT(SHARED) 835 ! cc$OMP+ PRIVATE(rdaym_ini,rdayvrai,ijb,ije) 836 837 ! c$OMP MASTER 838 ! call suspend_timer(timer_caldyn) 839 840 ! write(lunout,*) 841 ! & 'leapfrog_p: Entree dans la physique : Iteration No ',true_itau 842 ! c$OMP END MASTER 843 844 ! CALL pression_loc ( ip1jmp1, ap, bp, ps, p ) 845 846 ! c$OMP BARRIER 847 ! CALL exner_hyb_loc( ip1jmp1, ps, p,pks, pk, pkf ) 848 ! c$OMP BARRIER 849 ! jD_cur = jD_ref + day_ini - day_ref 850 ! $ + int (itau * dtvr / daysec) 851 ! jH_cur = jH_ref + & 852 ! & (itau * dtvr / daysec - int(itau * dtvr / daysec)) 853 ! ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes) 854 855 ! c rajout debug 856 ! c lafin = .true. 857 858 859 ! c Inbterface avec les routines de phylmd (phymars ... ) 860 ! c ----------------------------------------------------- 861 862 ! c+jld 863 864 ! c Diagnostique de conservation de l'energie : initialisation 865 ! 866 ! c-jld 867 ! c$OMP BARRIER 868 ! c$OMP MASTER 869 ! call VTb(VThallo) 870 ! c$OMP END MASTER 871 872 ! #ifdef DEBUG_IO 873 ! call WriteField_u('ucovfi',ucov) 874 ! call WriteField_v('vcovfi',vcov) 875 ! call WriteField_u('tetafi',teta) 876 ! call WriteField_u('pfi',p) 877 ! call WriteField_u('pkfi',pk) 878 ! #endif 879 ! call SetTag(Request_physic,800) 880 ! 881 ! call Register_SwapField_u(ucov,ucov,distrib_physic, 882 ! * Request_physic,up=2,down=2) 883 ! 884 ! call Register_SwapField_v(vcov,vcov,distrib_physic, 885 ! * Request_physic,up=2,down=2) 886 887 ! call Register_SwapField_u(teta,teta,distrib_physic, 888 ! * Request_physic,up=2,down=2) 889 ! 890 ! call Register_SwapField_u(masse,masse,distrib_physic, 891 ! * Request_physic,up=1,down=2) 892 893 ! call Register_SwapField_u(p,p,distrib_physic, 894 ! * Request_physic,up=2,down=2) 895 ! 896 ! call Register_SwapField_u(pk,pk,distrib_physic, 897 ! * Request_physic,up=2,down=2) 898 ! 899 ! call Register_SwapField_u(phis,phis,distrib_physic, 900 ! * Request_physic,up=2,down=2) 901 ! 902 ! call Register_SwapField_u(phi,phi,distrib_physic, 903 ! * Request_physic,up=2,down=2) 904 ! 905 ! call Register_SwapField_u(w,w,distrib_physic, 906 ! * Request_physic,up=2,down=2) 907 ! 908 ! call Register_SwapField_u(q,q,distrib_physic, 909 ! * Request_physic,up=2,down=2) 910 911 ! call Register_SwapField_u(flxw,flxw,distrib_physic, 912 ! * Request_physic,up=2,down=2) 913 ! 914 ! call SendRequest(Request_Physic) 915 ! c$OMP BARRIER 916 ! call WaitRequest(Request_Physic) 917 918 ! c$OMP BARRIER 919 ! c$OMP MASTER 920 ! call Set_Distrib(distrib_Physic) 921 ! call VTe(VThallo) 922 ! 923 ! call VTb(VTphysiq) 924 ! c$OMP END MASTER 925 ! c$OMP BARRIER 926 927 ! #ifdef DEBUG_IO 928 ! call WriteField_u('ucovfi',ucov) 929 ! call WriteField_v('vcovfi',vcov) 930 ! call WriteField_u('tetafi',teta) 931 ! call WriteField_u('pfi',p) 932 ! call WriteField_u('pkfi',pk) 933 ! do j=1,nqtot 934 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 935 ! enddo 936 ! #endif 937 ! STOP 938 ! c$OMP BARRIER 939 ! ! CALL FTRACE_REGION_BEGIN("calfis") 940 ! CALL calfis_loc(lafin ,jD_cur, jH_cur, 941 ! $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , 942 ! $ du,dv,dteta,dq, 943 ! $ flxw, 944 ! $ dufi,dvfi,dtetafi,dqfi,dpfi ) 945 ! ! CALL FTRACE_REGION_END("calfis") 946 ! ! ijb=ij_begin 947 ! ! ije=ij_end 948 ! ! if ( .not. pole_nord) then 949 ! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 950 ! ! DO l=1,llm 951 ! ! dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l) 952 ! ! dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l) 953 ! ! dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 954 ! ! dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 955 ! ! ENDDO 956 ! !c$OMP END DO NOWAIT 957 ! ! 958 ! !c$OMP MASTER 959 ! ! dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim) 960 ! !c$OMP END MASTER 961 ! ! endif ! of if ( .not. pole_nord) 962 963 ! !c$OMP BARRIER 964 ! !c$OMP MASTER 965 ! ! call Set_Distrib(distrib_physic_bis) 966 967 ! ! call VTb(VThallo) 968 ! !c$OMP END MASTER 969 ! !c$OMP BARRIER 970 ! ! 971 ! ! call Register_Hallo_u(dufi,llm, 972 ! ! * 1,0,0,1,Request_physic) 973 ! ! 974 ! ! call Register_Hallo_v(dvfi,llm, 975 ! ! * 1,0,0,1,Request_physic) 976 ! ! 977 ! ! call Register_Hallo_u(dtetafi,llm, 978 ! ! * 1,0,0,1,Request_physic) 979 ! ! 980 ! ! call Register_Hallo_u(dpfi,1, 981 ! ! * 1,0,0,1,Request_physic) 982 ! ! 983 ! ! do j=1,nqtot 984 ! ! call Register_Hallo_u(dqfi(ijb_u,1,j),llm, 985 ! ! * 1,0,0,1,Request_physic) 986 ! ! enddo 987 ! ! 988 ! ! call SendRequest(Request_Physic) 989 ! !c$OMP BARRIER 990 ! ! call WaitRequest(Request_Physic) 991 ! ! 992 ! !c$OMP BARRIER 993 ! !c$OMP MASTER 994 ! ! call VTe(VThallo) 995 ! ! 996 ! ! call set_Distrib(distrib_Physic) 997 ! !c$OMP END MASTER 998 ! !c$OMP BARRIER 999 ! ! ijb=ij_begin 1000 ! ! if (.not. pole_nord) then 1001 ! ! 1002 ! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1003 ! ! DO l=1,llm 1004 ! ! dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l) 1005 ! ! dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l) 1006 ! ! dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l) 1007 ! ! & +dtetafi_tmp(1:iip1,l) 1008 ! ! dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) 1009 ! ! & + dqfi_tmp(1:iip1,l,:) 1010 ! ! ENDDO 1011 ! !c$OMP END DO NOWAIT 1012 ! ! 1013 ! !c$OMP MASTER 1014 ! ! dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1) 1015 ! !c$OMP END MASTER 1016 ! ! 1017 ! ! endif ! of if (.not. pole_nord) 1018 1019 ! #ifdef DEBUG_IO 1020 ! call WriteField_u('dufi',dufi) 1021 ! call WriteField_v('dvfi',dvfi) 1022 ! call WriteField_u('dtetafi',dtetafi) 1023 ! call WriteField_u('dpfi',dpfi) 1024 ! do j=1,nqtot 1025 ! call WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j)) 1026 ! enddo 1027 ! #endif 1028 1029 ! c$OMP BARRIER 1030 1031 ! c ajout des tendances physiques: 1032 ! c ------------------------------ 1033 ! #ifdef DEBUG_IO 1034 ! call WriteField_u('ucovfi',ucov) 1035 ! call WriteField_v('vcovfi',vcov) 1036 ! call WriteField_u('tetafi',teta) 1037 ! call WriteField_u('psfi',ps) 1038 ! do j=1,nqtot 1039 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1040 ! enddo 1041 ! #endif 1042 1043 ! IF (ok_strato) THEN 1044 ! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi) 1045 ! ENDIF 1046 1047 ! #ifdef DEBUG_IO 1048 ! call WriteField_u('ucovfi',ucov) 1049 ! call WriteField_v('vcovfi',vcov) 1050 ! call WriteField_u('tetafi',teta) 1051 ! call WriteField_u('psfi',ps) 1052 ! do j=1,nqtot 1053 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1054 ! enddo 1055 ! #endif 1056 1057 ! CALL addfi_loc( dtphys, leapf, forward , 1058 ! $ ucov, vcov, teta , q ,ps , 1059 ! $ dufi, dvfi, dtetafi , dqfi ,dpfi ) 1060 1061 ! #ifdef DEBUG_IO 1062 ! call WriteField_u('ucovfi',ucov) 1063 ! call WriteField_v('vcovfi',vcov) 1064 ! call WriteField_u('tetafi',teta) 1065 ! call WriteField_u('psfi',ps) 1066 ! do j=1,nqtot 1067 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1068 ! enddo 1069 ! #endif 1070 1071 ! c$OMP BARRIER 1072 ! c$OMP MASTER 1073 ! call VTe(VTphysiq) 1074 1075 ! call VTb(VThallo) 1076 ! c$OMP END MASTER 1077 1078 ! call SetTag(Request_physic,800) 1079 ! call Register_SwapField_u(ucov,ucov, 1080 ! * distrib_caldyn,Request_physic) 1081 ! 1082 ! call Register_SwapField_v(vcov,vcov, 1083 ! * distrib_caldyn,Request_physic) 1084 ! 1085 ! call Register_SwapField_u(teta,teta, 1086 ! * distrib_caldyn,Request_physic) 1087 ! 1088 ! call Register_SwapField_u(masse,masse, 1089 ! * distrib_caldyn,Request_physic) 1090 1091 ! call Register_SwapField_u(p,p, 1092 ! * distrib_caldyn,Request_physic) 1093 ! 1094 ! call Register_SwapField_u(pk,pk, 1095 ! * distrib_caldyn,Request_physic) 1096 ! 1097 ! call Register_SwapField_u(phis,phis, 1098 ! * distrib_caldyn,Request_physic) 1099 ! 1100 ! call Register_SwapField_u(phi,phi, 1101 ! * distrib_caldyn,Request_physic) 1102 ! 1103 ! call Register_SwapField_u(w,w, 1104 ! * distrib_caldyn,Request_physic) 1105 1106 ! call Register_SwapField_u(q,q, 1107 ! * distrib_caldyn,Request_physic) 1108 ! 1109 ! call SendRequest(Request_Physic) 1110 ! c$OMP BARRIER 1111 ! call WaitRequest(Request_Physic) 1112 1113 ! c$OMP BARRIER 1114 ! c$OMP MASTER 1115 ! call VTe(VThallo) 1116 ! call set_distrib(distrib_caldyn) 1117 ! c$OMP END MASTER 1118 ! c$OMP BARRIER 1119 ! c 1120 ! c Diagnostique de conservation de l'energie : difference 1121 ! IF (ip_ebil_dyn.ge.1 ) THEN 1122 ! ztit='bil phys' 1123 ! CALL diagedyn(ztit,2,1,1,dtphys 1124 ! e , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2)) 1125 ! ENDIF 1126 1127 ! #ifdef DEBUG_IO 1128 ! call WriteField_u('ucovfi',ucov) 1129 ! call WriteField_v('vcovfi',vcov) 1130 ! call WriteField_u('tetafi',teta) 1131 ! call WriteField_u('psfi',ps) 1132 ! do j=1,nqtot 1133 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1134 ! enddo 1135 ! #endif 1136 1137 1138 ! c-jld 1139 !$OMP MASTER 1140 if (FirstPhysic) then 1141 ok_start_timer=.TRUE. 1142 FirstPhysic=.false. 1143 endif 1144 !$OMP END MASTER 1145 ENDIF ! of IF( apphys ) 1146 1147 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1132') 1148 ! !write(*,*) 'leapfrog 1134: iflag_phys=',iflag_phys 1149 1150 IF(iflag_phys.EQ.2) THEN ! "Newtonian" case 1151 !$OMP MASTER 1152 if (FirstPhysic) then 1153 ok_start_timer=.TRUE. 1154 FirstPhysic=.false. 1155 endif 1156 !$OMP END MASTER 1157 1158 1159 ! Calcul academique de la physique = Rappel Newtonien + fritcion 1160 ! -------------------------------------------------------------- 1161 !ym teta(:,:)=teta(:,:) 1162 !ym s -iphysiq*dtvr*(teta(:,:)-tetarappel(:,:))/taurappel 1163 ijb=ij_begin 1164 ije=ij_end 1165 !LF teta(ijb:ije,:)=teta(ijb:ije,:) 1166 !LF s -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel 1167 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1168 do l=1,llm 1169 teta(ijb:ije,l)=teta(ijb:ije,l) -dtvr* & 1170 (teta(ijb:ije,l)-tetarappel(ijb:ije,l))* & 1171 (knewt_g+knewt_t(l)*clat4(ijb:ije)) 1172 enddo 1173 !$OMP END DO 1174 1175 !$OMP MASTER 1176 if (planet_type.eq."giant") then 1177 ! ! add an intrinsic heat flux at the base of the atmosphere 1178 teta(ijb:ije,1) = teta(ijb:ije,1) & 1179 + dtvr * aire(ijb:ije) * ihf / cpp / masse(ijb:ije,1) 1180 endif 1181 !$OMP END MASTER 1182 !$OMP BARRIER 1183 1184 1185 call Register_Hallo_u(ucov,llm,0,1,1,0,Request_Physic) 1186 call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Physic) 1187 call SendRequest(Request_Physic) 1188 !$OMP BARRIER 1189 call WaitRequest(Request_Physic) 1190 !$OMP BARRIER 1191 call friction_loc(ucov,vcov,dtvr) 1192 !$OMP BARRIER 1193 1194 ! ! Sponge layer (if any) 1195 IF (ok_strato) THEN 1196 CALL top_bound_loc(vcov,ucov,teta,masse,dtvr) 1197 !$OMP BARRIER 1198 ENDIF ! of IF (ok_strato) 1199 ENDIF ! of IF(iflag_phys.EQ.2) 1200 1201 1202 CALL pression_loc ( ip1jmp1, ap, bp, ps, p ) 1203 !$OMP BARRIER 1204 if (pressure_exner) then 1205 CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf ) 1206 else 1207 CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf ) 1208 endif 1209 !$OMP BARRIER 1210 CALL massdair_loc(p,masse) 1211 !$OMP BARRIER 1212 1213 !c$OMP END PARALLEL 1214 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1196') 1215 1216 !----------------------------------------------------------------------- 1217 ! dissipation horizontale et verticale des petites echelles: 1218 ! ---------------------------------------------------------- 1219 ! !write(*,*) 'leapfrog 1163: apdiss=',apdiss 1220 IF(apdiss) THEN 1221 1222 CALL call_dissip(ucov,vcov,teta,p,pk,ps) 1223 !cc$OMP PARALLEL DEFAULT(SHARED) 1224 !cc$OMP+ PRIVATE(ijb,ije,tppn,tpn,tpps,tps) 1225 !c$OMP MASTER 1226 ! call suspend_timer(timer_caldyn) 1227 ! 1228 !c print*,'Entree dans la dissipation : Iteration No ',true_itau 1229 !c calcul de l'energie cinetique avant dissipation 1230 !c print *,'Passage dans la dissipation' 1231 1232 ! call VTb(VThallo) 1233 !c$OMP END MASTER 1234 1235 !c$OMP BARRIER 1236 1237 ! call Register_SwapField_u(ucov,ucov,distrib_dissip, 1238 ! * Request_dissip,up=1,down=1) 1239 1240 ! call Register_SwapField_v(vcov,vcov,distrib_dissip, 1241 ! * Request_dissip,up=1,down=1) 1242 1243 ! call Register_SwapField_u(teta,teta,distrib_dissip, 1244 ! * Request_dissip) 1245 1246 ! call Register_SwapField_u(p,p,distrib_dissip, 1247 ! * Request_dissip) 1248 1249 ! call Register_SwapField_u(pk,pk,distrib_dissip, 1250 ! * Request_dissip) 1251 1252 ! call SendRequest(Request_dissip) 1253 !c$OMP BARRIER 1254 ! call WaitRequest(Request_dissip) 1255 1256 !c$OMP BARRIER 1257 !c$OMP MASTER 1258 ! call set_distrib(distrib_dissip) 1259 ! call VTe(VThallo) 1260 ! call VTb(VTdissipation) 1261 ! call start_timer(timer_dissip) 1262 !c$OMP END MASTER 1263 !c$OMP BARRIER 1264 1265 ! call covcont_loc(llm,ucov,vcov,ucont,vcont) 1266 ! call enercin_loc(vcov,ucov,vcont,ucont,ecin0) 1267 1268 !c dissipation 1269 1270 !! CALL FTRACE_REGION_BEGIN("dissip") 1271 ! CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis) 1272 1273 !#ifdef DEBUG_IO 1274 ! call WriteField_u('dudis',dudis) 1275 ! call WriteField_v('dvdis',dvdis) 1276 ! call WriteField_u('dtetadis',dtetadis) 1277 !#endif 1278 ! 1279 !! CALL FTRACE_REGION_END("dissip") 1280 ! 1281 ! ijb=ij_begin 1282 ! ije=ij_end 1283 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1284 ! DO l=1,llm 1285 ! ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l) 1286 ! ENDDO 1287 !c$OMP END DO NOWAIT 1288 ! if (pole_sud) ije=ije-iip1 1289 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1290 ! DO l=1,llm 1291 ! vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l) 1292 ! ENDDO 1293 !c$OMP END DO NOWAIT 1294 1295 !c teta=teta+dtetadis 1296 1297 1298 !c------------------------------------------------------------------------ 1299 ! if (dissip_conservative) then 1300 !C On rajoute la tendance due a la transform. Ec -> E therm. cree 1301 !C lors de la dissipation 1302 !c$OMP BARRIER 1303 !c$OMP MASTER 1304 ! call suspend_timer(timer_dissip) 1305 ! call VTb(VThallo) 1306 !c$OMP END MASTER 1307 ! call Register_Hallo_u(ucov,llm,1,1,1,1,Request_Dissip) 1308 ! call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Dissip) 1309 ! call SendRequest(Request_Dissip) 1310 !c$OMP BARRIER 1311 ! call WaitRequest(Request_Dissip) 1312 !c$OMP MASTER 1313 ! call VTe(VThallo) 1314 ! call resume_timer(timer_dissip) 1315 !c$OMP END MASTER 1316 !c$OMP BARRIER 1317 ! call covcont_loc(llm,ucov,vcov,ucont,vcont) 1318 ! call enercin_loc(vcov,ucov,vcont,ucont,ecin) 1319 ! 1320 ! ijb=ij_begin 1321 ! ije=ij_end 1322 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1323 ! do l=1,llm 1324 ! do ij=ijb,ije 1325 ! dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l) 1326 ! dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l) 1327 ! enddo 1328 ! enddo 1329 !c$OMP END DO NOWAIT 1330 ! endif 1331 1332 ! ijb=ij_begin 1333 ! ije=ij_end 1334 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1335 ! do l=1,llm 1336 ! do ij=ijb,ije 1337 ! teta(ij,l)=teta(ij,l)+dtetadis(ij,l) 1338 ! enddo 1339 ! enddo 1340 !c$OMP END DO NOWAIT 1341 !c------------------------------------------------------------------------ 1342 1343 1344 !c ....... P. Le Van ( ajout le 17/04/96 ) ........... 1345 !c ... Calcul de la valeur moyenne, unique de h aux poles ..... 1346 !c 1347 1348 ! ijb=ij_begin 1349 ! ije=ij_end 1350 ! 1351 ! if (pole_nord) then 1352 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1353 ! DO l = 1, llm 1354 ! DO ij = 1,iim 1355 ! tppn(ij) = aire( ij ) * teta( ij ,l) 1356 ! ENDDO 1357 ! tpn = SSUM(iim,tppn,1)/apoln 1358 1359 ! DO ij = 1, iip1 1360 ! teta( ij ,l) = tpn 1361 ! ENDDO 1362 ! ENDDO 1363 !c$OMP END DO NOWAIT 1364 1365 !c$OMP MASTER 1366 ! DO ij = 1,iim 1367 ! tppn(ij) = aire( ij ) * ps ( ij ) 1368 ! ENDDO 1369 ! tpn = SSUM(iim,tppn,1)/apoln 1370 ! 1371 ! DO ij = 1, iip1 1372 ! ps( ij ) = tpn 1373 ! ENDDO 1374 !c$OMP END MASTER 1375 ! endif 1376 ! 1377 ! if (pole_sud) then 1378 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1379 ! DO l = 1, llm 1380 ! DO ij = 1,iim 1381 ! tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l) 1382 ! ENDDO 1383 ! tps = SSUM(iim,tpps,1)/apols 1384 1385 ! DO ij = 1, iip1 1386 ! teta(ij+ip1jm,l) = tps 1387 ! ENDDO 1388 ! ENDDO 1389 !c$OMP END DO NOWAIT 1390 1391 !c$OMP MASTER 1392 ! DO ij = 1,iim 1393 ! tpps(ij) = aire(ij+ip1jm) * ps (ij+ip1jm) 1394 ! ENDDO 1395 ! tps = SSUM(iim,tpps,1)/apols 1396 ! 1397 ! DO ij = 1, iip1 1398 ! ps(ij+ip1jm) = tps 1399 ! ENDDO 1400 !c$OMP END MASTER 1401 ! endif 1402 1403 1404 !c$OMP BARRIER 1405 !c$OMP MASTER 1406 ! call VTe(VTdissipation) 1407 1408 ! call stop_timer(timer_dissip) 1409 ! 1410 ! call VTb(VThallo) 1411 !c$OMP END MASTER 1412 ! call Register_SwapField_u(ucov,ucov,distrib_caldyn, 1413 ! * Request_dissip) 1414 1415 ! call Register_SwapField_v(vcov,vcov,distrib_caldyn, 1416 ! * Request_dissip) 1417 1418 ! call Register_SwapField_u(teta,teta,distrib_caldyn, 1419 ! * Request_dissip) 1420 1421 ! call Register_SwapField_u(p,p,distrib_caldyn, 1422 ! * Request_dissip) 1423 1424 ! call Register_SwapField_u(pk,pk,distrib_caldyn, 1425 ! * Request_dissip) 1426 1427 ! call SendRequest(Request_dissip) 1428 !c$OMP BARRIER 1429 ! call WaitRequest(Request_dissip) 1430 1431 !c$OMP BARRIER 1432 !c$OMP MASTER 1433 ! call set_distrib(distrib_caldyn) 1434 ! call VTe(VThallo) 1435 ! call resume_timer(timer_caldyn) 1436 !c print *,'fin dissipation' 1437 !c$OMP END MASTER 1438 !c$OMP BARRIER 1439 END IF ! of IF(apdiss) 1440 1441 !c$OMP END PARALLEL 1442 1443 ! ajout debug 1444 ! IF( lafin ) then 1445 ! abort_message = 'Simulation finished' 1446 ! call abort_gcm(modname,abort_message,0) 1447 ! ENDIF 1448 1449 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1430') 1450 1451 ! ******************************************************************** 1452 ! ******************************************************************** 1453 ! .... fin de l'integration dynamique et physique pour le pas itau .. 1454 ! ******************************************************************** 1455 ! ******************************************************************** 1456 1457 ! preparation du pas d'integration suivant ...... 1458 !ym call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 1459 !ym call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/))) 1460 !$OMP MASTER 1461 call stop_timer(timer_caldyn) 1462 !$OMP END MASTER 1463 IF (itau==itaumax) then 1464 !$OMP MASTER 1465 call allgather_timer_average 1466 call barrier 1467 if (mpi_rank==0) then 1468 505 1469 print *,'*********************************' 506 1470 print *,'****** TIMER CALDYN ******' 507 1471 do i=0,mpi_size-1 508 print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), 509 & ' : temps moyen :', 510 & timer_average(jj_nb_caldyn(i),timer_caldyn,i), 511 & '+-',timer_delta(jj_nb_caldyn(i),timer_caldyn,i) 1472 print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), & 1473 ' : temps moyen :', & 1474 timer_average(jj_nb_caldyn(i),timer_caldyn,i) 512 1475 enddo 513 1476 514 1477 print *,'*********************************' 515 1478 print *,'****** TIMER VANLEER ******' 516 1479 do i=0,mpi_size-1 517 print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), 518 & ' : temps moyen :', 519 & timer_average(jj_nb_vanleer(i),timer_vanleer,i), 520 & '+-',timer_delta(jj_nb_vanleer(i),timer_vanleer,i) 1480 print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), & 1481 ' : temps moyen :', & 1482 timer_average(jj_nb_vanleer(i),timer_vanleer,i) 521 1483 enddo 522 1484 523 1485 print *,'*********************************' 524 1486 print *,'****** TIMER DISSIP ******' 525 1487 do i=0,mpi_size-1 526 print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), 527 & ' : temps moyen :', 528 & timer_average(jj_nb_dissip(i),timer_dissip,i), 529 & '+-',timer_delta(jj_nb_dissip(i),timer_dissip,i) 1488 print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), & 1489 ' : temps moyen :', & 1490 timer_average(jj_nb_dissip(i),timer_dissip,i) 530 1491 enddo 531 532 ! if (mpi_rank==0) call WriteBands 533 534 endif 535 536 call AdjustBands_caldyn(new_dist) 537 !$OMP END MASTER 538 !$OMP BARRIER 539 CALL leapfrog_switch_caldyn(new_dist) 540 !$OMP BARRIER 541 542 543 !$OMP MASTER 544 distrib_caldyn=new_dist 545 CALL set_distrib(distrib_caldyn) 546 !$OMP END MASTER 547 !$OMP BARRIER 548 ! call Register_SwapFieldHallo(ucov,ucov,ip1jmp1,llm, 549 ! & jj_Nb_caldyn,0,0,TestRequest) 550 ! call Register_SwapFieldHallo(ucovm1,ucovm1,ip1jmp1,llm, 551 ! & jj_Nb_caldyn,0,0,TestRequest) 552 ! call Register_SwapFieldHallo(vcov,vcov,ip1jm,llm, 553 ! & jj_Nb_caldyn,0,0,TestRequest) 554 ! call Register_SwapFieldHallo(vcovm1,vcovm1,ip1jm,llm, 555 ! & jj_Nb_caldyn,0,0,TestRequest) 556 ! call Register_SwapFieldHallo(teta,teta,ip1jmp1,llm, 557 ! & jj_Nb_caldyn,0,0,TestRequest) 558 ! call Register_SwapFieldHallo(tetam1,tetam1,ip1jmp1,llm, 559 ! & jj_Nb_caldyn,0,0,TestRequest) 560 ! call Register_SwapFieldHallo(masse,masse,ip1jmp1,llm, 561 ! & jj_Nb_caldyn,0,0,TestRequest) 562 ! call Register_SwapFieldHallo(massem1,massem1,ip1jmp1,llm, 563 ! & jj_Nb_caldyn,0,0,TestRequest) 564 ! call Register_SwapFieldHallo(ps,ps,ip1jmp1,1, 565 ! & jj_Nb_caldyn,0,0,TestRequest) 566 ! call Register_SwapFieldHallo(psm1,psm1,ip1jmp1,1, 567 ! & jj_Nb_caldyn,0,0,TestRequest) 568 ! call Register_SwapFieldHallo(pkf,pkf,ip1jmp1,llm, 569 ! & jj_Nb_caldyn,0,0,TestRequest) 570 ! call Register_SwapFieldHallo(pk,pk,ip1jmp1,llm, 571 ! & jj_Nb_caldyn,0,0,TestRequest) 572 ! call Register_SwapFieldHallo(pks,pks,ip1jmp1,1, 573 ! & jj_Nb_caldyn,0,0,TestRequest) 574 ! call Register_SwapFieldHallo(phis,phis,ip1jmp1,1, 575 ! & jj_Nb_caldyn,0,0,TestRequest) 576 ! call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm, 577 ! & jj_Nb_caldyn,0,0,TestRequest) 578 ! call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm, 579 ! & jj_Nb_caldyn,0,0,TestRequest) 580 ! 581 ! do j=1,nqtot 582 ! call Register_SwapFieldHallo(q(:,:,j),q(:,:,j),ip1jmp1,llm, 583 ! & jj_nb_caldyn,0,0,TestRequest) 584 ! enddo 585 ! 586 ! call Set_Distrib(distrib_caldyn) 587 ! call SendRequest(TestRequest) 588 ! call WaitRequest(TestRequest) 589 590 !$OMP MASTER 591 call AdjustBands_dissip(new_dist) 592 !$OMP END MASTER 593 !$OMP BARRIER 594 CALL leapfrog_switch_dissip(new_dist) 595 !$OMP BARRIER 596 !$OMP MASTER 597 distrib_dissip=new_dist 598 !$OMP END MASTER 599 !$OMP BARRIER 600 ! call AdjustBands_physic 601 602 c$OMP MASTER 603 if (mpi_rank==0) call WriteBands 604 c$OMP END MASTER 605 606 607 endif 608 endif 609 610 611 call check_isotopes(q,ijb_u,ije_u,'leapfrog 589') 612 613 c----------------------------------------------------------------------- 614 c calcul des tendances dynamiques: 615 c -------------------------------- 616 c$OMP BARRIER 617 c$OMP MASTER 618 call VTb(VThallo) 619 c$OMP END MASTER 620 621 call Register_Hallo_u(ucov,llm,1,1,1,1,TestRequest) 622 call Register_Hallo_v(vcov,llm,1,1,1,1,TestRequest) 623 call Register_Hallo_u(teta,llm,1,1,1,1,TestRequest) 624 call Register_Hallo_u(ps,1,1,2,2,1,TestRequest) 625 call Register_Hallo_u(pkf,llm,1,1,1,1,TestRequest) 626 call Register_Hallo_u(pk,llm,1,1,1,1,TestRequest) 627 call Register_Hallo_u(pks,1,1,1,1,1,TestRequest) 628 call Register_Hallo_u(p,llmp1,1,1,1,1,TestRequest) 629 630 c do j=1,nqtot 631 c call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1, 632 c * TestRequest) 633 c enddo 634 635 call SendRequest(TestRequest) 636 c$OMP BARRIER 637 call WaitRequest(TestRequest) 638 639 c$OMP MASTER 640 call VTe(VThallo) 641 c$OMP END MASTER 642 c$OMP BARRIER 643 644 if (debug) then 645 call WriteField_u('ucov',ucov) 646 call WriteField_v('vcov',vcov) 647 call WriteField_u('teta',teta) 648 call WriteField_u('ps',ps) 649 call WriteField_u('masse',masse) 650 call WriteField_u('pk',pk) 651 call WriteField_u('pks',pks) 652 call WriteField_u('pkf',pkf) 653 call WriteField_u('phis',phis) 654 do iq=1,nqtot 655 call WriteField_u('q'//trim(int2str(iq)), 656 . q(:,:,iq)) 1492 1493 print *,'*********************************' 1494 print *,'****** TIMER PHYSIC ******' 1495 do i=0,mpi_size-1 1496 print *,'proc',i,' : Nb Bandes :',jj_nb_physic(i), & 1497 ' : temps moyen :', & 1498 timer_average(jj_nb_physic(i),timer_physic,i) 657 1499 enddo 658 endif 659 660 661 True_itau=True_itau+1 662 663 c$OMP MASTER 664 IF (prt_level>9) THEN 665 WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau 666 ENDIF 667 668 669 call start_timer(timer_caldyn) 670 671 ! compute geopotential phi() 672 CALL geopot_loc ( ip1jmp1, teta , pk , pks, phis , phi ) 673 674 call check_isotopes(q,ijb_u,ije_u,'leapfrog 651') 675 676 call VTb(VTcaldyn) 677 c$OMP END MASTER 678 ! var_time=time+iday-day_ini 679 680 c$OMP BARRIER 681 ! CALL FTRACE_REGION_BEGIN("caldyn") 682 time = jD_cur + jH_cur 683 684 CALL caldyn_loc 685 $ ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis , 686 $ phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time ) 687 688 ! CALL FTRACE_REGION_END("caldyn") 689 690 c$OMP MASTER 691 if (mpi_rank==0.AND.conser) THEN 692 WRITE(lunout,*) 'leapfrog_loc, Time step: ',itau,' Day:',time 693 ENDIF 694 call VTe(VTcaldyn) 695 c$OMP END MASTER 696 697 #ifdef DEBUG_IO 698 call WriteField_u('du',du) 699 call WriteField_v('dv',dv) 700 call WriteField_u('dteta',dteta) 701 call WriteField_u('dp',dp) 702 call WriteField_u('w',w) 703 call WriteField_u('pbaru',pbaru) 704 call WriteField_v('pbarv',pbarv) 705 call WriteField_u('p',p) 706 call WriteField_u('masse',masse) 707 call WriteField_u('pk',pk) 708 #endif 709 c----------------------------------------------------------------------- 710 c calcul des tendances advection des traceurs (dont l'humidite) 711 c ------------------------------------------------------------- 712 713 call check_isotopes(q,ijb_u,ije_u, 714 & 'leapfrog 686: avant caladvtrac') 715 716 IF( forward. OR . leapf ) THEN 717 ! Ehouarn: NB: fields sent to advtrac are those at the beginning of the time step 718 !write(*,*) 'leapfrog 679: avant CALL caladvtrac_loc' 719 CALL caladvtrac_loc(q,pbaru,pbarv, 720 * p, masse, dq, teta, 721 . flxw,pk, iapptrac) 722 723 ! call creation of mass flux 724 IF (offline .AND. .NOT. adjust) THEN 725 CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi) 726 ENDIF 727 728 !write(*,*) 'leapfrog 719' 729 call check_isotopes(q,ijb_u,ije_u, 730 & 'leapfrog 698: apres caladvtrac') 731 732 ! do j=1,nqtot 733 ! call WriteField_u('qadv'//trim(int2str(j)),q(:,:,j)) 734 ! enddo 735 736 ! Ehouarn: Storage of mass flux for off-line tracers... not implemented... 737 738 ENDIF ! of IF( forward. OR . leapf ) 739 740 741 c----------------------------------------------------------------------- 742 c integrations dynamique et traceurs: 743 c ---------------------------------- 744 745 c$OMP MASTER 746 call VTb(VTintegre) 747 c$OMP END MASTER 748 #ifdef DEBUG_IO 749 if (true_itau>20) then 750 call WriteField_u('ucovm1',ucovm1) 751 call WriteField_v('vcovm1',vcovm1) 752 call WriteField_u('tetam1',tetam1) 753 call WriteField_u('psm1',psm1) 754 call WriteField_u('ucov_int',ucov) 755 call WriteField_v('vcov_int',vcov) 756 call WriteField_u('teta_int',teta) 757 call WriteField_u('ps_int',ps) 758 endif 759 #endif 760 c$OMP BARRIER 761 ! CALL FTRACE_REGION_BEGIN("integrd") 762 763 !write(*,*) 'leapfrog 720' 764 call check_isotopes(q,ijb_u,ije_u,'leapfrog 756') 765 766 ! CRisi: pourquoi aller jusqu'à 2 et non pas jusqu'à nqtot?? 767 CALL integrd_loc ( nqtot,vcovm1,ucovm1,tetam1,psm1,massem1 , 768 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis) 769 ! $ finvmaold ) 770 771 !write(*,*) 'leapfrog 724' 772 call check_isotopes(q,ijb_u,ije_u,'leapfrog 762') 773 774 ! CALL FTRACE_REGION_END("integrd") 775 c$OMP BARRIER 776 #ifdef DEBUG_IO 777 call WriteField_u('ucovm1',ucovm1) 778 call WriteField_v('vcovm1',vcovm1) 779 call WriteField_u('tetam1',tetam1) 780 call WriteField_u('psm1',psm1) 781 call WriteField_u('ucov_int',ucov) 782 call WriteField_v('vcov_int',vcov) 783 call WriteField_u('teta_int',teta) 784 call WriteField_u('ps_int',ps) 785 #endif 786 787 call check_isotopes(q,ijb_u,ije_u,'leapfrog 775') 788 789 c do j=1,nqtot 790 c call WriteField_p('q'//trim(int2str(j)), 791 c . reshape(q(:,:,j),(/iip1,jmp1,llm/))) 792 c call WriteField_p('dq'//trim(int2str(j)), 793 c . reshape(dq(:,:,j),(/iip1,jmp1,llm/))) 794 c enddo 795 796 797 c$OMP MASTER 798 call VTe(VTintegre) 799 c$OMP END MASTER 800 c .P.Le Van (26/04/94 ajout de finvpold dans l'appel d'integrd) 801 c 802 c----------------------------------------------------------------------- 803 c calcul des tendances physiques: 804 c ------------------------------- 805 c ######## P.Le Van ( Modif le 6/02/95 ) ########### 806 c 807 IF( purmats ) THEN 808 IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE. 809 ELSE 810 IF( itau+1. EQ. itaufin ) lafin = .TRUE. 811 ENDIF 812 813 cc$OMP END PARALLEL 814 815 c 816 c 817 IF( apphys ) THEN 818 819 CALL call_calfis(itau,lafin,ucov,vcov,teta,masse,ps, 820 & phis,q,flxw) 821 ! #ifdef DEBUG_IO 822 ! call WriteField_u('ucovfi',ucov) 823 ! call WriteField_v('vcovfi',vcov) 824 ! call WriteField_u('tetafi',teta) 825 ! call WriteField_u('pfi',p) 826 ! call WriteField_u('pkfi',pk) 827 ! do j=1,nqtot 828 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 829 ! enddo 830 ! #endif 831 ! c 832 ! c ....... Ajout P.Le Van ( 17/04/96 ) ........... 833 ! c 834 ! cc$OMP PARALLEL DEFAULT(SHARED) 835 ! cc$OMP+ PRIVATE(rdaym_ini,rdayvrai,ijb,ije) 836 837 ! c$OMP MASTER 838 ! call suspend_timer(timer_caldyn) 839 840 ! write(lunout,*) 841 ! & 'leapfrog_p: Entree dans la physique : Iteration No ',true_itau 842 ! c$OMP END MASTER 843 844 ! CALL pression_loc ( ip1jmp1, ap, bp, ps, p ) 845 846 ! c$OMP BARRIER 847 ! CALL exner_hyb_loc( ip1jmp1, ps, p,pks, pk, pkf ) 848 ! c$OMP BARRIER 849 ! jD_cur = jD_ref + day_ini - day_ref 850 ! $ + int (itau * dtvr / daysec) 851 ! jH_cur = jH_ref + & 852 ! & (itau * dtvr / daysec - int(itau * dtvr / daysec)) 853 ! ! call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes) 854 855 ! c rajout debug 856 ! c lafin = .true. 857 858 859 ! c Inbterface avec les routines de phylmd (phymars ... ) 860 ! c ----------------------------------------------------- 861 862 ! c+jld 863 864 ! c Diagnostique de conservation de l'energie : initialisation 865 ! 866 ! c-jld 867 ! c$OMP BARRIER 868 ! c$OMP MASTER 869 ! call VTb(VThallo) 870 ! c$OMP END MASTER 871 872 ! #ifdef DEBUG_IO 873 ! call WriteField_u('ucovfi',ucov) 874 ! call WriteField_v('vcovfi',vcov) 875 ! call WriteField_u('tetafi',teta) 876 ! call WriteField_u('pfi',p) 877 ! call WriteField_u('pkfi',pk) 878 ! #endif 879 ! call SetTag(Request_physic,800) 880 ! 881 ! call Register_SwapField_u(ucov,ucov,distrib_physic, 882 ! * Request_physic,up=2,down=2) 883 ! 884 ! call Register_SwapField_v(vcov,vcov,distrib_physic, 885 ! * Request_physic,up=2,down=2) 886 887 ! call Register_SwapField_u(teta,teta,distrib_physic, 888 ! * Request_physic,up=2,down=2) 889 ! 890 ! call Register_SwapField_u(masse,masse,distrib_physic, 891 ! * Request_physic,up=1,down=2) 892 893 ! call Register_SwapField_u(p,p,distrib_physic, 894 ! * Request_physic,up=2,down=2) 895 ! 896 ! call Register_SwapField_u(pk,pk,distrib_physic, 897 ! * Request_physic,up=2,down=2) 898 ! 899 ! call Register_SwapField_u(phis,phis,distrib_physic, 900 ! * Request_physic,up=2,down=2) 901 ! 902 ! call Register_SwapField_u(phi,phi,distrib_physic, 903 ! * Request_physic,up=2,down=2) 904 ! 905 ! call Register_SwapField_u(w,w,distrib_physic, 906 ! * Request_physic,up=2,down=2) 907 ! 908 ! call Register_SwapField_u(q,q,distrib_physic, 909 ! * Request_physic,up=2,down=2) 910 911 ! call Register_SwapField_u(flxw,flxw,distrib_physic, 912 ! * Request_physic,up=2,down=2) 913 ! 914 ! call SendRequest(Request_Physic) 915 ! c$OMP BARRIER 916 ! call WaitRequest(Request_Physic) 917 918 ! c$OMP BARRIER 919 ! c$OMP MASTER 920 ! call Set_Distrib(distrib_Physic) 921 ! call VTe(VThallo) 922 ! 923 ! call VTb(VTphysiq) 924 ! c$OMP END MASTER 925 ! c$OMP BARRIER 926 927 ! #ifdef DEBUG_IO 928 ! call WriteField_u('ucovfi',ucov) 929 ! call WriteField_v('vcovfi',vcov) 930 ! call WriteField_u('tetafi',teta) 931 ! call WriteField_u('pfi',p) 932 ! call WriteField_u('pkfi',pk) 933 ! do j=1,nqtot 934 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 935 ! enddo 936 ! #endif 937 ! STOP 938 ! c$OMP BARRIER 939 ! ! CALL FTRACE_REGION_BEGIN("calfis") 940 ! CALL calfis_loc(lafin ,jD_cur, jH_cur, 941 ! $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , 942 ! $ du,dv,dteta,dq, 943 ! $ flxw, 944 ! $ dufi,dvfi,dtetafi,dqfi,dpfi ) 945 ! ! CALL FTRACE_REGION_END("calfis") 946 ! ! ijb=ij_begin 947 ! ! ije=ij_end 948 ! ! if ( .not. pole_nord) then 949 ! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 950 ! ! DO l=1,llm 951 ! ! dufi_tmp(1:iip1,l) = dufi(ijb:ijb+iim,l) 952 ! ! dvfi_tmp(1:iip1,l) = dvfi(ijb:ijb+iim,l) 953 ! ! dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 954 ! ! dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 955 ! ! ENDDO 956 ! !c$OMP END DO NOWAIT 957 ! ! 958 ! !c$OMP MASTER 959 ! ! dpfi_tmp(1:iip1) = dpfi(ijb:ijb+iim) 960 ! !c$OMP END MASTER 961 ! ! endif ! of if ( .not. pole_nord) 962 963 ! !c$OMP BARRIER 964 ! !c$OMP MASTER 965 ! ! call Set_Distrib(distrib_physic_bis) 966 967 ! ! call VTb(VThallo) 968 ! !c$OMP END MASTER 969 ! !c$OMP BARRIER 970 ! ! 971 ! ! call Register_Hallo_u(dufi,llm, 972 ! ! * 1,0,0,1,Request_physic) 973 ! ! 974 ! ! call Register_Hallo_v(dvfi,llm, 975 ! ! * 1,0,0,1,Request_physic) 976 ! ! 977 ! ! call Register_Hallo_u(dtetafi,llm, 978 ! ! * 1,0,0,1,Request_physic) 979 ! ! 980 ! ! call Register_Hallo_u(dpfi,1, 981 ! ! * 1,0,0,1,Request_physic) 982 ! ! 983 ! ! do j=1,nqtot 984 ! ! call Register_Hallo_u(dqfi(ijb_u,1,j),llm, 985 ! ! * 1,0,0,1,Request_physic) 986 ! ! enddo 987 ! ! 988 ! ! call SendRequest(Request_Physic) 989 ! !c$OMP BARRIER 990 ! ! call WaitRequest(Request_Physic) 991 ! ! 992 ! !c$OMP BARRIER 993 ! !c$OMP MASTER 994 ! ! call VTe(VThallo) 995 ! ! 996 ! ! call set_Distrib(distrib_Physic) 997 ! !c$OMP END MASTER 998 ! !c$OMP BARRIER 999 ! ! ijb=ij_begin 1000 ! ! if (.not. pole_nord) then 1001 ! ! 1002 ! !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1003 ! ! DO l=1,llm 1004 ! ! dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l) 1005 ! ! dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l) 1006 ! ! dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l) 1007 ! ! & +dtetafi_tmp(1:iip1,l) 1008 ! ! dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) 1009 ! ! & + dqfi_tmp(1:iip1,l,:) 1010 ! ! ENDDO 1011 ! !c$OMP END DO NOWAIT 1012 ! ! 1013 ! !c$OMP MASTER 1014 ! ! dpfi(ijb:ijb+iim) = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1) 1015 ! !c$OMP END MASTER 1016 ! ! 1017 ! ! endif ! of if (.not. pole_nord) 1018 1019 ! #ifdef DEBUG_IO 1020 ! call WriteField_u('dufi',dufi) 1021 ! call WriteField_v('dvfi',dvfi) 1022 ! call WriteField_u('dtetafi',dtetafi) 1023 ! call WriteField_u('dpfi',dpfi) 1024 ! do j=1,nqtot 1025 ! call WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j)) 1026 ! enddo 1027 ! #endif 1028 1029 ! c$OMP BARRIER 1030 1031 ! c ajout des tendances physiques: 1032 ! c ------------------------------ 1033 ! #ifdef DEBUG_IO 1034 ! call WriteField_u('ucovfi',ucov) 1035 ! call WriteField_v('vcovfi',vcov) 1036 ! call WriteField_u('tetafi',teta) 1037 ! call WriteField_u('psfi',ps) 1038 ! do j=1,nqtot 1039 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1040 ! enddo 1041 ! #endif 1042 1043 ! IF (ok_strato) THEN 1044 ! CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi) 1045 ! ENDIF 1046 1047 ! #ifdef DEBUG_IO 1048 ! call WriteField_u('ucovfi',ucov) 1049 ! call WriteField_v('vcovfi',vcov) 1050 ! call WriteField_u('tetafi',teta) 1051 ! call WriteField_u('psfi',ps) 1052 ! do j=1,nqtot 1053 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1054 ! enddo 1055 ! #endif 1056 1057 ! CALL addfi_loc( dtphys, leapf, forward , 1058 ! $ ucov, vcov, teta , q ,ps , 1059 ! $ dufi, dvfi, dtetafi , dqfi ,dpfi ) 1060 1061 ! #ifdef DEBUG_IO 1062 ! call WriteField_u('ucovfi',ucov) 1063 ! call WriteField_v('vcovfi',vcov) 1064 ! call WriteField_u('tetafi',teta) 1065 ! call WriteField_u('psfi',ps) 1066 ! do j=1,nqtot 1067 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1068 ! enddo 1069 ! #endif 1070 1071 ! c$OMP BARRIER 1072 ! c$OMP MASTER 1073 ! call VTe(VTphysiq) 1074 1075 ! call VTb(VThallo) 1076 ! c$OMP END MASTER 1077 1078 ! call SetTag(Request_physic,800) 1079 ! call Register_SwapField_u(ucov,ucov, 1080 ! * distrib_caldyn,Request_physic) 1081 ! 1082 ! call Register_SwapField_v(vcov,vcov, 1083 ! * distrib_caldyn,Request_physic) 1084 ! 1085 ! call Register_SwapField_u(teta,teta, 1086 ! * distrib_caldyn,Request_physic) 1087 ! 1088 ! call Register_SwapField_u(masse,masse, 1089 ! * distrib_caldyn,Request_physic) 1090 1091 ! call Register_SwapField_u(p,p, 1092 ! * distrib_caldyn,Request_physic) 1093 ! 1094 ! call Register_SwapField_u(pk,pk, 1095 ! * distrib_caldyn,Request_physic) 1096 ! 1097 ! call Register_SwapField_u(phis,phis, 1098 ! * distrib_caldyn,Request_physic) 1099 ! 1100 ! call Register_SwapField_u(phi,phi, 1101 ! * distrib_caldyn,Request_physic) 1102 ! 1103 ! call Register_SwapField_u(w,w, 1104 ! * distrib_caldyn,Request_physic) 1105 1106 ! call Register_SwapField_u(q,q, 1107 ! * distrib_caldyn,Request_physic) 1108 ! 1109 ! call SendRequest(Request_Physic) 1110 ! c$OMP BARRIER 1111 ! call WaitRequest(Request_Physic) 1112 1113 ! c$OMP BARRIER 1114 ! c$OMP MASTER 1115 ! call VTe(VThallo) 1116 ! call set_distrib(distrib_caldyn) 1117 ! c$OMP END MASTER 1118 ! c$OMP BARRIER 1119 ! c 1120 ! c Diagnostique de conservation de l'energie : difference 1121 ! IF (ip_ebil_dyn.ge.1 ) THEN 1122 ! ztit='bil phys' 1123 ! CALL diagedyn(ztit,2,1,1,dtphys 1124 ! e , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2)) 1125 ! ENDIF 1126 1127 ! #ifdef DEBUG_IO 1128 ! call WriteField_u('ucovfi',ucov) 1129 ! call WriteField_v('vcovfi',vcov) 1130 ! call WriteField_u('tetafi',teta) 1131 ! call WriteField_u('psfi',ps) 1132 ! do j=1,nqtot 1133 ! call WriteField_u('qfi'//trim(int2str(j)),q(:,:,j)) 1134 ! enddo 1135 ! #endif 1136 1137 1138 ! c-jld 1139 c$OMP MASTER 1140 if (FirstPhysic) then 1141 ok_start_timer=.TRUE. 1142 FirstPhysic=.false. 1143 endif 1144 c$OMP END MASTER 1145 ENDIF ! of IF( apphys ) 1146 1147 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1132') 1148 !write(*,*) 'leapfrog 1134: iflag_phys=',iflag_phys 1149 1150 IF(iflag_phys.EQ.2) THEN ! "Newtonian" case 1151 c$OMP MASTER 1152 if (FirstPhysic) then 1153 ok_start_timer=.TRUE. 1154 FirstPhysic=.false. 1155 endif 1156 c$OMP END MASTER 1157 1158 1159 c Calcul academique de la physique = Rappel Newtonien + fritcion 1160 c -------------------------------------------------------------- 1161 cym teta(:,:)=teta(:,:) 1162 cym s -iphysiq*dtvr*(teta(:,:)-tetarappel(:,:))/taurappel 1163 ijb=ij_begin 1164 ije=ij_end 1165 !LF teta(ijb:ije,:)=teta(ijb:ije,:) 1166 !LF s -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel 1167 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1168 do l=1,llm 1169 teta(ijb:ije,l)=teta(ijb:ije,l) -dtvr* 1170 & (teta(ijb:ije,l)-tetarappel(ijb:ije,l))* 1171 & (knewt_g+knewt_t(l)*clat4(ijb:ije)) 1172 enddo 1173 !$OMP END DO 1174 1175 !$OMP MASTER 1176 if (planet_type.eq."giant") then 1177 ! add an intrinsic heat flux at the base of the atmosphere 1178 teta(ijb:ije,1) = teta(ijb:ije,1) 1179 & + dtvr * aire(ijb:ije) * ihf / cpp / masse(ijb:ije,1) 1180 endif 1181 !$OMP END MASTER 1182 !$OMP BARRIER 1183 1184 1185 call Register_Hallo_u(ucov,llm,0,1,1,0,Request_Physic) 1186 call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Physic) 1187 call SendRequest(Request_Physic) 1188 c$OMP BARRIER 1189 call WaitRequest(Request_Physic) 1190 c$OMP BARRIER 1191 call friction_loc(ucov,vcov,dtvr) 1192 !$OMP BARRIER 1193 1194 ! Sponge layer (if any) 1195 IF (ok_strato) THEN 1196 CALL top_bound_loc(vcov,ucov,teta,masse,dtvr) 1197 !$OMP BARRIER 1198 ENDIF ! of IF (ok_strato) 1199 ENDIF ! of IF(iflag_phys.EQ.2) 1200 1201 1202 CALL pression_loc ( ip1jmp1, ap, bp, ps, p ) 1203 c$OMP BARRIER 1204 if (pressure_exner) then 1205 CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk, pkf ) 1206 else 1207 CALL exner_milieu_loc( ijnb_u, ps, p, pks, pk, pkf ) 1208 endif 1209 c$OMP BARRIER 1210 CALL massdair_loc(p,masse) 1211 c$OMP BARRIER 1212 1213 cc$OMP END PARALLEL 1214 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1196') 1215 1216 c----------------------------------------------------------------------- 1217 c dissipation horizontale et verticale des petites echelles: 1218 c ---------------------------------------------------------- 1219 !write(*,*) 'leapfrog 1163: apdiss=',apdiss 1220 IF(apdiss) THEN 1221 1222 CALL call_dissip(ucov,vcov,teta,p,pk,ps) 1223 !cc$OMP PARALLEL DEFAULT(SHARED) 1224 !cc$OMP+ PRIVATE(ijb,ije,tppn,tpn,tpps,tps) 1225 !c$OMP MASTER 1226 ! call suspend_timer(timer_caldyn) 1227 ! 1228 !c print*,'Entree dans la dissipation : Iteration No ',true_itau 1229 !c calcul de l'energie cinetique avant dissipation 1230 !c print *,'Passage dans la dissipation' 1231 1232 ! call VTb(VThallo) 1233 !c$OMP END MASTER 1234 1235 !c$OMP BARRIER 1236 1237 ! call Register_SwapField_u(ucov,ucov,distrib_dissip, 1238 ! * Request_dissip,up=1,down=1) 1239 1240 ! call Register_SwapField_v(vcov,vcov,distrib_dissip, 1241 ! * Request_dissip,up=1,down=1) 1242 1243 ! call Register_SwapField_u(teta,teta,distrib_dissip, 1244 ! * Request_dissip) 1245 1246 ! call Register_SwapField_u(p,p,distrib_dissip, 1247 ! * Request_dissip) 1248 1249 ! call Register_SwapField_u(pk,pk,distrib_dissip, 1250 ! * Request_dissip) 1251 1252 ! call SendRequest(Request_dissip) 1253 !c$OMP BARRIER 1254 ! call WaitRequest(Request_dissip) 1255 1256 !c$OMP BARRIER 1257 !c$OMP MASTER 1258 ! call set_distrib(distrib_dissip) 1259 ! call VTe(VThallo) 1260 ! call VTb(VTdissipation) 1261 ! call start_timer(timer_dissip) 1262 !c$OMP END MASTER 1263 !c$OMP BARRIER 1264 1265 ! call covcont_loc(llm,ucov,vcov,ucont,vcont) 1266 ! call enercin_loc(vcov,ucov,vcont,ucont,ecin0) 1267 1268 !c dissipation 1269 1270 !! CALL FTRACE_REGION_BEGIN("dissip") 1271 ! CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis) 1272 1273 !#ifdef DEBUG_IO 1274 ! call WriteField_u('dudis',dudis) 1275 ! call WriteField_v('dvdis',dvdis) 1276 ! call WriteField_u('dtetadis',dtetadis) 1277 !#endif 1278 ! 1279 !! CALL FTRACE_REGION_END("dissip") 1280 ! 1281 ! ijb=ij_begin 1282 ! ije=ij_end 1283 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1284 ! DO l=1,llm 1285 ! ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l) 1286 ! ENDDO 1287 !c$OMP END DO NOWAIT 1288 ! if (pole_sud) ije=ije-iip1 1289 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1290 ! DO l=1,llm 1291 ! vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l) 1292 ! ENDDO 1293 !c$OMP END DO NOWAIT 1294 1295 !c teta=teta+dtetadis 1296 1297 1298 !c------------------------------------------------------------------------ 1299 ! if (dissip_conservative) then 1300 !C On rajoute la tendance due a la transform. Ec -> E therm. cree 1301 !C lors de la dissipation 1302 !c$OMP BARRIER 1303 !c$OMP MASTER 1304 ! call suspend_timer(timer_dissip) 1305 ! call VTb(VThallo) 1306 !c$OMP END MASTER 1307 ! call Register_Hallo_u(ucov,llm,1,1,1,1,Request_Dissip) 1308 ! call Register_Hallo_v(vcov,llm,1,1,1,1,Request_Dissip) 1309 ! call SendRequest(Request_Dissip) 1310 !c$OMP BARRIER 1311 ! call WaitRequest(Request_Dissip) 1312 !c$OMP MASTER 1313 ! call VTe(VThallo) 1314 ! call resume_timer(timer_dissip) 1315 !c$OMP END MASTER 1316 !c$OMP BARRIER 1317 ! call covcont_loc(llm,ucov,vcov,ucont,vcont) 1318 ! call enercin_loc(vcov,ucov,vcont,ucont,ecin) 1319 ! 1320 ! ijb=ij_begin 1321 ! ije=ij_end 1322 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1323 ! do l=1,llm 1324 ! do ij=ijb,ije 1325 ! dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l) 1326 ! dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l) 1327 ! enddo 1328 ! enddo 1329 !c$OMP END DO NOWAIT 1330 ! endif 1331 1332 ! ijb=ij_begin 1333 ! ije=ij_end 1334 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1335 ! do l=1,llm 1336 ! do ij=ijb,ije 1337 ! teta(ij,l)=teta(ij,l)+dtetadis(ij,l) 1338 ! enddo 1339 ! enddo 1340 !c$OMP END DO NOWAIT 1341 !c------------------------------------------------------------------------ 1342 1343 1344 !c ....... P. Le Van ( ajout le 17/04/96 ) ........... 1345 !c ... Calcul de la valeur moyenne, unique de h aux poles ..... 1346 !c 1347 1348 ! ijb=ij_begin 1349 ! ije=ij_end 1350 ! 1351 ! if (pole_nord) then 1352 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1353 ! DO l = 1, llm 1354 ! DO ij = 1,iim 1355 ! tppn(ij) = aire( ij ) * teta( ij ,l) 1356 ! ENDDO 1357 ! tpn = SSUM(iim,tppn,1)/apoln 1358 1359 ! DO ij = 1, iip1 1360 ! teta( ij ,l) = tpn 1361 ! ENDDO 1362 ! ENDDO 1363 !c$OMP END DO NOWAIT 1364 1365 !c$OMP MASTER 1366 ! DO ij = 1,iim 1367 ! tppn(ij) = aire( ij ) * ps ( ij ) 1368 ! ENDDO 1369 ! tpn = SSUM(iim,tppn,1)/apoln 1370 ! 1371 ! DO ij = 1, iip1 1372 ! ps( ij ) = tpn 1373 ! ENDDO 1374 !c$OMP END MASTER 1375 ! endif 1376 ! 1377 ! if (pole_sud) then 1378 !c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1379 ! DO l = 1, llm 1380 ! DO ij = 1,iim 1381 ! tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l) 1382 ! ENDDO 1383 ! tps = SSUM(iim,tpps,1)/apols 1384 1385 ! DO ij = 1, iip1 1386 ! teta(ij+ip1jm,l) = tps 1387 ! ENDDO 1388 ! ENDDO 1389 !c$OMP END DO NOWAIT 1390 1391 !c$OMP MASTER 1392 ! DO ij = 1,iim 1393 ! tpps(ij) = aire(ij+ip1jm) * ps (ij+ip1jm) 1394 ! ENDDO 1395 ! tps = SSUM(iim,tpps,1)/apols 1396 ! 1397 ! DO ij = 1, iip1 1398 ! ps(ij+ip1jm) = tps 1399 ! ENDDO 1400 !c$OMP END MASTER 1401 ! endif 1402 1403 1404 !c$OMP BARRIER 1405 !c$OMP MASTER 1406 ! call VTe(VTdissipation) 1407 1408 ! call stop_timer(timer_dissip) 1409 ! 1410 ! call VTb(VThallo) 1411 !c$OMP END MASTER 1412 ! call Register_SwapField_u(ucov,ucov,distrib_caldyn, 1413 ! * Request_dissip) 1414 1415 ! call Register_SwapField_v(vcov,vcov,distrib_caldyn, 1416 ! * Request_dissip) 1417 1418 ! call Register_SwapField_u(teta,teta,distrib_caldyn, 1419 ! * Request_dissip) 1420 1421 ! call Register_SwapField_u(p,p,distrib_caldyn, 1422 ! * Request_dissip) 1423 1424 ! call Register_SwapField_u(pk,pk,distrib_caldyn, 1425 ! * Request_dissip) 1426 1427 ! call SendRequest(Request_dissip) 1428 !c$OMP BARRIER 1429 ! call WaitRequest(Request_dissip) 1430 1431 !c$OMP BARRIER 1432 !c$OMP MASTER 1433 ! call set_distrib(distrib_caldyn) 1434 ! call VTe(VThallo) 1435 ! call resume_timer(timer_caldyn) 1436 !c print *,'fin dissipation' 1437 !c$OMP END MASTER 1438 !c$OMP BARRIER 1439 END IF ! of IF(apdiss) 1440 1441 cc$OMP END PARALLEL 1442 1443 c ajout debug 1444 c IF( lafin ) then 1445 c abort_message = 'Simulation finished' 1446 c call abort_gcm(modname,abort_message,0) 1447 c ENDIF 1448 1449 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1430') 1450 1451 c ******************************************************************** 1452 c ******************************************************************** 1453 c .... fin de l'integration dynamique et physique pour le pas itau .. 1454 c ******************************************************************** 1455 c ******************************************************************** 1456 1457 c preparation du pas d'integration suivant ...... 1458 cym call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 1459 cym call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/))) 1460 c$OMP MASTER 1461 call stop_timer(timer_caldyn) 1462 c$OMP END MASTER 1463 IF (itau==itaumax) then 1464 c$OMP MASTER 1465 call allgather_timer_average 1466 call barrier 1467 if (mpi_rank==0) then 1468 1469 print *,'*********************************' 1470 print *,'****** TIMER CALDYN ******' 1471 do i=0,mpi_size-1 1472 print *,'proc',i,' : Nb Bandes :',jj_nb_caldyn(i), 1473 & ' : temps moyen :', 1474 & timer_average(jj_nb_caldyn(i),timer_caldyn,i) 1475 enddo 1476 1477 print *,'*********************************' 1478 print *,'****** TIMER VANLEER ******' 1479 do i=0,mpi_size-1 1480 print *,'proc',i,' : Nb Bandes :',jj_nb_vanleer(i), 1481 & ' : temps moyen :', 1482 & timer_average(jj_nb_vanleer(i),timer_vanleer,i) 1483 enddo 1484 1485 print *,'*********************************' 1486 print *,'****** TIMER DISSIP ******' 1487 do i=0,mpi_size-1 1488 print *,'proc',i,' : Nb Bandes :',jj_nb_dissip(i), 1489 & ' : temps moyen :', 1490 & timer_average(jj_nb_dissip(i),timer_dissip,i) 1491 enddo 1492 1493 print *,'*********************************' 1494 print *,'****** TIMER PHYSIC ******' 1495 do i=0,mpi_size-1 1496 print *,'proc',i,' : Nb Bandes :',jj_nb_physic(i), 1497 & ' : temps moyen :', 1498 & timer_average(jj_nb_physic(i),timer_physic,i) 1499 enddo 1500 1501 endif 1502 CALL barrier 1503 print *,'Taille du Buffer MPI (REAL*8)',MaxBufferSize 1504 print *,'Taille du Buffer MPI utilise (REAL*8)',MaxBufferSize_Used 1505 print *, 'Temps total ecoule sur la parallelisation :',DiffTime() 1506 print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime() 1507 CALL print_filtre_timer 1508 c$OMP END MASTER 1509 CALL dynredem1_loc("restart.nc",0.0, 1510 . vcov,ucov,teta,q,masse,ps) 1511 c$OMP MASTER 1512 call fin_getparam 1513 c$OMP END MASTER 1514 1515 if (ok_guide) then 1516 ! set ok_guide to false to avoid extra output 1517 ! in following forward step 1518 ok_guide=.false. 1519 endif 1500 1501 endif 1502 CALL barrier 1503 print *,'Taille du Buffer MPI (REAL*8)',MaxBufferSize 1504 print *,'Taille du Buffer MPI utilise (REAL*8)',MaxBufferSize_Used 1505 print *, 'Temps total ecoule sur la parallelisation :',DiffTime() 1506 print *, 'Temps CPU ecoule sur la parallelisation :',DiffCpuTime() 1507 CALL print_filtre_timer 1508 !$OMP END MASTER 1509 CALL dynredem1_loc("restart.nc",0.0, & 1510 vcov,ucov,teta,q,masse,ps) 1511 !$OMP MASTER 1512 call fin_getparam 1513 !$OMP END MASTER 1514 1515 if (ok_guide) then 1516 ! ! set ok_guide to false to avoid extra output 1517 ! ! in following forward step 1518 ok_guide=.false. 1519 endif 1520 1520 1521 1521 #ifdef INCA 1522 1523 1524 !switching back to LMDZDYN context1525 !$OMP MASTER 1526 1527 1528 1529 !$OMP END MASTER 1530 1522 IF (ANY(type_trac == ['inca','inco'])) THEN 1523 CALL finalize_inca 1524 ! switching back to LMDZDYN context 1525 !$OMP MASTER 1526 IF (ok_dyn_xios) THEN 1527 CALL xios_set_current_context(dyn3d_ctx_handle) 1528 ENDIF 1529 !$OMP END MASTER 1530 ENDIF 1531 1531 #endif 1532 1532 #ifdef REPROBUS 1533 1533 if (type_trac == 'repr') CALL finalize_reprobus 1534 1534 #endif 1535 1535 1536 c$OMP MASTER1537 1538 c$OMP END MASTER1539 c$OMP BARRIER1540 1541 1542 1543 1544 1545 1546 c........................................................1547 c.............. schema matsuno + leapfrog ..............1548 c........................................................1549 1550 IF(forward.OR. leapf) THEN1551 1552 !iday= day_ini+itau/day_step1553 !time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_01554 !IF(time.GT.1.) THEN1555 !time = time-1.1556 !iday = iday+11557 !ENDIF1558 1559 1560 1561 IF( itau.EQ. itaufinp1 ) then1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 c$OMP MASTER1575 1576 c$OMP END MASTER1536 !$OMP MASTER 1537 call finalize_parallel 1538 !$OMP END MASTER 1539 !$OMP BARRIER 1540 RETURN 1541 ENDIF 1542 1543 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1509') 1544 1545 IF ( .NOT.purmats ) THEN 1546 ! ........................................................ 1547 ! .............. schema matsuno + leapfrog .............. 1548 ! ........................................................ 1549 1550 IF(forward.OR. leapf) THEN 1551 itau= itau + 1 1552 ! iday= day_ini+itau/day_step 1553 ! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1554 ! IF(time.GT.1.) THEN 1555 ! time = time-1. 1556 ! iday = iday+1 1557 ! ENDIF 1558 ENDIF 1559 1560 1561 IF( itau.EQ. itaufinp1 ) then 1562 1563 if (flag_verif) then 1564 write(79,*) 'ucov',ucov 1565 write(80,*) 'vcov',vcov 1566 write(81,*) 'teta',teta 1567 write(82,*) 'ps',ps 1568 write(83,*) 'q',q 1569 WRITE(85,*) 'q1 = ',q(:,:,1) 1570 WRITE(86,*) 'q3 = ',q(:,:,3) 1571 endif 1572 1573 1574 !$OMP MASTER 1575 call fin_getparam 1576 !$OMP END MASTER 1577 1577 1578 1578 #ifdef INCA 1579 1580 1581 !switching back to LMDZDYN context1582 !$OMP MASTER 1583 1584 1585 1586 !$OMP END MASTER 1587 1579 IF (ANY(type_trac == ['inca','inco'])) THEN 1580 CALL finalize_inca 1581 ! switching back to LMDZDYN context 1582 !$OMP MASTER 1583 IF (ok_dyn_xios) THEN 1584 CALL xios_set_current_context(dyn3d_ctx_handle) 1585 ENDIF 1586 !$OMP END MASTER 1587 ENDIF 1588 1588 #endif 1589 1589 #ifdef REPROBUS 1590 1590 if (type_trac == 'repr') CALL finalize_reprobus 1591 1591 #endif 1592 1592 1593 c$OMP MASTER 1594 call finalize_parallel 1595 c$OMP END MASTER 1596 abort_message = 'Simulation finished' 1597 call abort_gcm(modname,abort_message,0) 1598 RETURN 1599 ENDIF 1600 c----------------------------------------------------------------------- 1601 c ecriture du fichier histoire moyenne: 1602 c ------------------------------------- 1603 1604 IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN 1605 c$OMP BARRIER 1606 IF(itau.EQ.itaufin) THEN 1607 iav=1 1593 !$OMP MASTER 1594 call finalize_parallel 1595 !$OMP END MASTER 1596 abort_message = 'Simulation finished' 1597 call abort_gcm(modname,abort_message,0) 1598 RETURN 1599 ENDIF 1600 !----------------------------------------------------------------------- 1601 ! ecriture du fichier histoire moyenne: 1602 ! ------------------------------------- 1603 1604 IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN 1605 !$OMP BARRIER 1606 IF(itau.EQ.itaufin) THEN 1607 iav=1 1608 ELSE 1609 iav=0 1610 ENDIF 1611 1612 ! ! Ehouarn: re-compute geopotential for outputs 1613 !$OMP BARRIER 1614 !$OMP MASTER 1615 CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi) 1616 !$OMP END MASTER 1617 !$OMP BARRIER 1618 1619 #ifdef CPP_IOIPSL 1620 IF (ok_dynzon) THEN 1621 1622 CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav, & 1623 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 1624 1625 ENDIF !ok_dynzon 1626 1627 IF (ok_dyn_ave) THEN 1628 CALL writedynav_loc(itau,vcov, & 1629 ucov,teta,pk,phi,q,masse,ps,phis) 1630 ENDIF 1631 #endif 1632 1633 1634 ENDIF 1635 1636 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1584') 1637 1638 !----------------------------------------------------------------------- 1639 ! ecriture de la bande histoire: 1640 ! ------------------------------ 1641 1642 IF( MOD(itau,iecri).EQ.0) THEN 1643 ! ! Ehouarn: output only during LF or Backward Matsuno 1644 if (leapf.or.(.not.leapf.and.(.not.forward))) then 1645 1646 !$OMP BARRIER 1647 !$OMP MASTER 1648 CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi) 1649 !$OMP END MASTER 1650 !$OMP BARRIER 1651 1652 #ifdef CPP_IOIPSL 1653 if (ok_dyn_ins) then 1654 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, & 1655 masse,ps,phis) 1656 endif 1657 #endif 1658 1659 IF (ok_dyn_xios) THEN 1660 !$OMP MASTER 1661 CALL xios_update_calendar(itau) 1662 !$OMP END MASTER 1663 !$OMP BARRIER 1664 CALL writedyn_xios(vcov, & 1665 ucov,teta,pk,phi,q,masse,ps,phis) 1666 ENDIF 1667 1668 endif ! of if (leapf.or.(.not.leapf.and.(.not.forward))) 1669 1670 1671 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 1672 1673 IF(itau.EQ.itaufin) THEN 1674 1675 !$OMP BARRIER 1676 1677 ! if (planet_type.eq."earth") then 1678 ! Write an Earth-format restart file 1679 CALL dynredem1_loc("restart.nc",0.0, & 1680 vcov,ucov,teta,q,masse,ps) 1681 ! endif ! of if (planet_type.eq."earth") 1682 if (ok_guide) then 1683 ! ! set ok_guide to false to avoid extra output 1684 ! ! in following forward step 1685 ok_guide=.false. 1686 endif 1687 1688 ! CLOSE(99) 1689 ENDIF ! of IF (itau.EQ.itaufin) 1690 1691 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1624') 1692 1693 !----------------------------------------------------------------------- 1694 ! gestion de l'integration temporelle: 1695 ! ------------------------------------ 1696 1697 IF( MOD(itau,iperiod).EQ.0 ) THEN 1698 GO TO 1 1699 ELSE IF ( MOD(itau-1,iperiod).EQ. 0 ) THEN 1700 1701 IF( forward ) THEN 1702 ! fin du pas forward et debut du pas backward 1703 1704 forward = .FALSE. 1705 leapf = .FALSE. 1706 GO TO 2 1707 1608 1708 ELSE 1609 iav=0 1610 ENDIF 1611 1612 ! Ehouarn: re-compute geopotential for outputs 1613 c$OMP BARRIER 1614 c$OMP MASTER 1615 CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi) 1616 c$OMP END MASTER 1617 c$OMP BARRIER 1618 1619 #ifdef CPP_IOIPSL 1620 IF (ok_dynzon) THEN 1621 1622 CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav, 1623 , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 1624 1625 ENDIF !ok_dynzon 1626 1627 IF (ok_dyn_ave) THEN 1628 CALL writedynav_loc(itau,vcov, 1629 & ucov,teta,pk,phi,q,masse,ps,phis) 1630 ENDIF 1631 #endif 1632 1633 1634 ENDIF 1635 1636 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1584') 1637 1638 c----------------------------------------------------------------------- 1639 c ecriture de la bande histoire: 1640 c ------------------------------ 1641 1642 IF( MOD(itau,iecri).EQ.0) THEN 1643 ! Ehouarn: output only during LF or Backward Matsuno 1644 if (leapf.or.(.not.leapf.and.(.not.forward))) then 1645 1646 c$OMP BARRIER 1647 c$OMP MASTER 1648 CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi) 1649 c$OMP END MASTER 1650 c$OMP BARRIER 1651 1652 #ifdef CPP_IOIPSL 1653 if (ok_dyn_ins) then 1654 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, 1655 & masse,ps,phis) 1656 endif 1657 #endif 1658 1659 IF (ok_dyn_xios) THEN 1660 c$OMP MASTER 1661 CALL xios_update_calendar(itau) 1662 c$OMP END MASTER 1663 c$OMP BARRIER 1664 CALL writedyn_xios(vcov, 1665 & ucov,teta,pk,phi,q,masse,ps,phis) 1666 ENDIF 1667 1668 endif ! of if (leapf.or.(.not.leapf.and.(.not.forward))) 1669 1670 1671 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 1672 1673 IF(itau.EQ.itaufin) THEN 1674 1675 c$OMP BARRIER 1676 1677 ! if (planet_type.eq."earth") then 1678 ! Write an Earth-format restart file 1679 CALL dynredem1_loc("restart.nc",0.0, 1680 & vcov,ucov,teta,q,masse,ps) 1681 ! endif ! of if (planet_type.eq."earth") 1682 if (ok_guide) then 1683 ! set ok_guide to false to avoid extra output 1684 ! in following forward step 1685 ok_guide=.false. 1686 endif 1687 1688 ! CLOSE(99) 1689 ENDIF ! of IF (itau.EQ.itaufin) 1690 1691 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1624') 1692 1693 c----------------------------------------------------------------------- 1694 c gestion de l'integration temporelle: 1695 c ------------------------------------ 1696 1697 IF( MOD(itau,iperiod).EQ.0 ) THEN 1698 GO TO 1 1699 ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN 1700 1701 IF( forward ) THEN 1702 c fin du pas forward et debut du pas backward 1703 1704 forward = .FALSE. 1705 leapf = .FALSE. 1706 GO TO 2 1707 1708 ELSE 1709 c fin du pas backward et debut du premier pas leapfrog 1710 1711 leapf = .TRUE. 1712 dt = 2.*dtvr 1713 GO TO 2 1714 END IF 1715 ELSE 1716 1717 c ...... pas leapfrog ..... 1718 1719 leapf = .TRUE. 1720 dt = 2.*dtvr 1721 GO TO 2 1722 END IF ! of IF (MOD(itau,iperiod).EQ.0) 1723 ! ELSEIF (MOD(itau-1,iperiod).EQ.0) 1724 1725 1726 ELSE ! of IF (.not.purmats) 1727 1728 1729 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1664') 1730 1731 c ........................................................ 1732 c .............. schema matsuno ............... 1733 c ........................................................ 1734 IF( forward ) THEN 1735 1736 itau = itau + 1 1737 ! iday = day_ini+itau/day_step 1738 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1739 ! 1740 ! IF(time.GT.1.) THEN 1741 ! time = time-1. 1742 ! iday = iday+1 1743 ! ENDIF 1744 1745 forward = .FALSE. 1746 IF( itau. EQ. itaufinp1 ) then 1747 c$OMP MASTER 1748 call fin_getparam 1749 c$OMP END MASTER 1709 ! fin du pas backward et debut du premier pas leapfrog 1710 1711 leapf = .TRUE. 1712 dt = 2.*dtvr 1713 GO TO 2 1714 END IF 1715 ELSE 1716 1717 ! ...... pas leapfrog ..... 1718 1719 leapf = .TRUE. 1720 dt = 2.*dtvr 1721 GO TO 2 1722 END IF ! of IF (MOD(itau,iperiod).EQ.0) 1723 ! ! ELSEIF (MOD(itau-1,iperiod).EQ.0) 1724 1725 1726 ELSE ! of IF (.not.purmats) 1727 1728 1729 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1664') 1730 1731 ! ........................................................ 1732 ! .............. schema matsuno ............... 1733 ! ........................................................ 1734 IF( forward ) THEN 1735 1736 itau = itau + 1 1737 ! iday = day_ini+itau/day_step 1738 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1739 ! 1740 ! IF(time.GT.1.) THEN 1741 ! time = time-1. 1742 ! iday = iday+1 1743 ! ENDIF 1744 1745 forward = .FALSE. 1746 IF( itau.EQ. itaufinp1 ) then 1747 !$OMP MASTER 1748 call fin_getparam 1749 !$OMP END MASTER 1750 1750 1751 1751 #ifdef INCA 1752 1753 1754 !switching back to LMDZDYN context1755 !$OMP MASTER 1756 1757 1758 1759 !$OMP END MASTER 1760 1752 IF (ANY(type_trac == ['inca','inco'])) THEN 1753 CALL finalize_inca 1754 ! switching back to LMDZDYN context 1755 !$OMP MASTER 1756 IF (ok_dyn_xios) THEN 1757 CALL xios_set_current_context(dyn3d_ctx_handle) 1758 ENDIF 1759 !$OMP END MASTER 1760 ENDIF 1761 1761 1762 1762 #endif 1763 1763 #ifdef REPROBUS 1764 1764 if (type_trac == 'repr') CALL finalize_reprobus 1765 1765 #endif 1766 1766 1767 c$OMP MASTER1768 1769 c$OMP END MASTER1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1767 !$OMP MASTER 1768 call finalize_parallel 1769 !$OMP END MASTER 1770 abort_message = 'Simulation finished' 1771 call abort_gcm(modname,abort_message,0) 1772 RETURN 1773 ENDIF 1774 GO TO 2 1775 1776 ELSE ! of IF(forward) i.e. backward step 1777 1778 1779 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1698') 1780 1781 IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN 1782 IF(itau.EQ.itaufin) THEN 1783 iav=1 1784 ELSE 1785 iav=0 1786 ENDIF 1787 1787 1788 1788 #ifdef CPP_IOIPSL 1789 1790 c$OMP BARRIER1791 c$OMP MASTER1792 1793 c$OMP END MASTER1794 c$OMP BARRIER1795 1796 1797 CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav,1798 ,ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)1799 1800 1801 1802 CALL writedynav_loc(itau,vcov,1803 &ucov,teta,pk,phi,q,masse,ps,phis)1804 1789 ! ! Ehouarn: re-compute geopotential for outputs 1790 !$OMP BARRIER 1791 !$OMP MASTER 1792 CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi) 1793 !$OMP END MASTER 1794 !$OMP BARRIER 1795 1796 IF (ok_dynzon) THEN 1797 CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav, & 1798 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 1799 ENDIF 1800 1801 IF (ok_dyn_ave) THEN 1802 CALL writedynav_loc(itau,vcov, & 1803 ucov,teta,pk,phi,q,masse,ps,phis) 1804 ENDIF 1805 1805 #endif 1806 1807 1808 1809 1810 1811 1812 1813 c$OMP BARRIER1814 c$OMP MASTER1815 1816 c$OMP END MASTER1817 c$OMP BARRIER1806 1807 1808 ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) 1809 1810 1811 IF(MOD(itau,iecri ).EQ.0) THEN 1812 1813 !$OMP BARRIER 1814 !$OMP MASTER 1815 CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi) 1816 !$OMP END MASTER 1817 !$OMP BARRIER 1818 1818 1819 1819 1820 1820 #ifdef CPP_IOIPSL 1821 1822 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q,1823 &masse,ps,phis)1824 1821 if (ok_dyn_ins) then 1822 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, & 1823 masse,ps,phis) 1824 endif ! of if (ok_dyn_ins) 1825 1825 #endif 1826 1826 1827 1828 c$OMP MASTER1829 1830 c$OMP END MASTER1831 c$OMP BARRIER1832 CALL writedyn_xios(vcov,1833 &ucov,teta,pk,phi,q,masse,ps,phis)1834 1835 1836 1837 1838 1839 1840 !if (planet_type.eq."earth") then1841 CALL dynredem1_loc("restart.nc",0.0,1842 .vcov,ucov,teta,q,masse,ps)1843 !endif ! of if (planet_type.eq."earth")1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 c$OMP MASTER1862 1863 c$OMP END MASTER1827 IF (ok_dyn_xios) THEN 1828 !$OMP MASTER 1829 CALL xios_update_calendar(itau) 1830 !$OMP END MASTER 1831 !$OMP BARRIER 1832 CALL writedyn_xios(vcov, & 1833 ucov,teta,pk,phi,q,masse,ps,phis) 1834 ENDIF 1835 1836 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 1837 1838 1839 IF(itau.EQ.itaufin) THEN 1840 ! if (planet_type.eq."earth") then 1841 CALL dynredem1_loc("restart.nc",0.0, & 1842 vcov,ucov,teta,q,masse,ps) 1843 ! endif ! of if (planet_type.eq."earth") 1844 if (ok_guide) then 1845 ! ! set ok_guide to false to avoid extra output 1846 ! ! in following forward step 1847 ok_guide=.false. 1848 endif 1849 1850 ENDIF ! of IF(itau.EQ.itaufin) 1851 1852 forward = .TRUE. 1853 GO TO 1 1854 1855 ENDIF ! of IF (forward) 1856 1857 1858 call check_isotopes(q,ijb_u,ije_u,'leapfrog 1750') 1859 1860 END IF ! of IF(.not.purmats) 1861 !$OMP MASTER 1862 call fin_getparam 1863 !$OMP END MASTER 1864 1864 1865 1865 #ifdef INCA 1866 1867 1868 !switching back to LMDZDYN context1869 !$OMP MASTER 1870 1871 1872 1873 !$OMP END MASTER 1874 1866 IF (ANY(type_trac == ['inca','inco'])) THEN 1867 CALL finalize_inca 1868 ! switching back to LMDZDYN context 1869 !$OMP MASTER 1870 IF (ok_dyn_xios) THEN 1871 CALL xios_set_current_context(dyn3d_ctx_handle) 1872 ENDIF 1873 !$OMP END MASTER 1874 ENDIF 1875 1875 1876 1876 #endif 1877 1877 #ifdef REPROBUS 1878 1878 if (type_trac == 'repr') CALL finalize_reprobus 1879 1879 #endif 1880 1880 1881 c$OMP MASTER1882 1883 c$OMP END MASTER1884 1885 1886 1887 END 1881 !$OMP MASTER 1882 call finalize_parallel 1883 !$OMP END MASTER 1884 abort_message = 'Simulation finished' 1885 call abort_gcm(modname,abort_message,0) 1886 RETURN 1887 END SUBROUTINE leapfrog_loc
Note: See TracChangeset
for help on using the changeset viewer.
