Changeset 5103 for LMDZ6/branches/Amaury_dev/libf/dyn3dmem
- Timestamp:
- Jul 23, 2024, 3:29:36 PM (16 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/dyn3dmem
- Files:
-
- 37 edited
- 1 moved
-
abort_gcm.F (modified) (3 diffs)
-
advtrac_loc.f90 (modified) (2 diffs)
-
bands.F90 (modified) (9 diffs)
-
bernoui_loc.F (modified) (1 diff)
-
bilan_dyn_loc.F (modified) (12 diffs)
-
call_dissip_mod.f90 (modified) (1 diff)
-
conf_gcm.F90 (modified) (10 diffs)
-
dteta1_loc.F (modified) (1 diff)
-
dynredem_loc.F90 (modified) (2 diffs)
-
exner_hyb_loc_m.F90 (modified) (2 diffs)
-
exner_milieu_loc_m.F90 (modified) (2 diffs)
-
friction_loc.F (modified) (3 diffs)
-
gcm.F90 (modified) (11 diffs)
-
getparam.F90 (modified) (1 diff)
-
groupe_loc.f90 (modified) (2 diffs)
-
guide_loc_mod.F90 (modified) (10 diffs)
-
iniacademic_loc.F90 (modified) (7 diffs)
-
initdynav_loc.F (modified) (11 diffs)
-
initfluxsto_p.F (modified) (16 diffs)
-
inithist_loc.F90 (modified) (3 diffs)
-
integrd_loc.F (modified) (1 diff)
-
leapfrog_loc.F90 (modified) (27 diffs)
-
lmdz_call_calfis.F90 (modified) (2 diffs)
-
mod_const_mpi.F90 (modified) (1 diff)
-
mod_hallo.F90 (modified) (25 diffs)
-
mod_xios_dyn3dmem.F90 (modified) (1 diff)
-
parallel_lmdz.F90 (modified) (12 diffs)
-
times.F90 (modified) (10 diffs)
-
top_bound_loc.F (modified) (3 diffs)
-
vlsplt_loc.F (modified) (9 diffs)
-
vlspltgen_loc.F90 (modified) (15 diffs)
-
vlspltqs_loc.F (modified) (2 diffs)
-
wrgrads.f90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.F) (1 diff)
-
write_field_loc.F90 (modified) (6 diffs)
-
write_field_p.F90 (modified) (4 diffs)
-
writedyn_xios.F90 (modified) (1 diff)
-
writedynav_loc.F (modified) (17 diffs)
-
writehist_loc.F (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/abort_gcm.F
r5101 r5103 6 6 SUBROUTINE abort_gcm(modname, message, ierr) 7 7 8 #ifdef CPP_IOIPSL9 8 USE IOIPSL 10 #else11 ! if not using IOIPSL, we still need to use (a local version of) getin_dump12 USE ioipsl_getincom13 #endif14 9 USE parallel_lmdz 15 10 INCLUDE "iniprint.h" … … 28 23 29 24 write(lunout,*) 'in abort_gcm' 30 #ifdef CPP_IOIPSL31 25 c$OMP MASTER 32 26 CALL histclo … … 36 30 endif 37 31 c$OMP END MASTER 38 #endif39 32 c CALL histclo(2) 40 33 c CALL histclo(3) -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90
r5101 r5103 12 12 USE parallel_lmdz 13 13 USE Write_Field_loc 14 USE Write_Field15 14 USE Bands 16 15 USE mod_hallo … … 19 18 USE advtrac_mod, ONLY: finmasse 20 19 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO 20 USE strings_mod, ONLY: int2str 21 21 22 22 IMPLICIT NONE -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bands.F90
r5101 r5103 26 26 contains 27 27 28 subroutineAllocateBands28 SUBROUTINE AllocateBands 29 29 USE parallel_lmdz 30 30 implicit none … … 38 38 allocate(distrib_phys(0:MPI_Size-1)) 39 39 40 end subroutineAllocateBands41 42 subroutineRead_distrib40 END SUBROUTINE AllocateBands 41 42 SUBROUTINE Read_distrib 43 43 USE parallel_lmdz 44 44 implicit none … … 100 100 ! distrib_phys(mpi_size-1) = distrib_phys(mpi_size-1) - (iim-1) 101 101 102 end subroutineRead_distrib102 END SUBROUTINE Read_distrib 103 103 104 104 … … 171 171 distrib_physic_bis%ijnb_v=distrib_physic%ijnb_v 172 172 173 end subroutineSet_Bands174 175 176 subroutineAdjustBands_caldyn(new_dist)173 END SUBROUTINE Set_Bands 174 175 176 SUBROUTINE AdjustBands_caldyn(new_dist) 177 177 use times 178 178 USE parallel_lmdz … … 239 239 CALL create_distrib(jj_nb_caldyn,new_dist) 240 240 241 end subroutineAdjustBands_caldyn241 END SUBROUTINE AdjustBands_caldyn 242 242 243 subroutineAdjustBands_vanleer(new_dist)243 SUBROUTINE AdjustBands_vanleer(new_dist) 244 244 use times 245 245 USE parallel_lmdz … … 308 308 CALL create_distrib(jj_nb_vanleer,new_dist) 309 309 310 end subroutineAdjustBands_vanleer311 312 subroutineAdjustBands_dissip(new_dist)310 END SUBROUTINE AdjustBands_vanleer 311 312 SUBROUTINE AdjustBands_dissip(new_dist) 313 313 use times 314 314 USE parallel_lmdz … … 377 377 CALL create_distrib(jj_nb_dissip,new_dist) 378 378 379 end subroutineAdjustBands_dissip380 381 subroutineAdjustBands_physic379 END SUBROUTINE AdjustBands_dissip 380 381 SUBROUTINE AdjustBands_physic 382 382 use times 383 383 … … 434 434 END IF 435 435 436 end subroutineAdjustBands_physic437 438 subroutineWriteBands436 END SUBROUTINE AdjustBands_physic 437 438 SUBROUTINE WriteBands 439 439 USE parallel_lmdz 440 440 implicit none … … 483 483 endif 484 484 485 end subroutineWriteBands485 END SUBROUTINE WriteBands 486 486 487 487 end module Bands -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.F
r5086 r5103 68 68 69 69 CALL filtreg_p( pbern,jjb_u,jje_u,jjb,jje, jjp1, llm, 70 & 2,1, . true., 1 )70 & 2,1, .TRUE., 1 ) 71 71 c 72 72 c----------------------------------------------------------------------- -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.F
r5101 r5103 10 10 c vQ..A=Cp T + L * ... 11 11 12 #ifdef CPP_IOIPSL13 12 USE IOIPSL 14 #endif15 13 USE parallel_lmdz 16 14 USE mod_hallo … … 222 220 icum=0 223 221 c initialisation des fichiers 224 first=. false.222 first=.FALSE. 225 223 c ncum est la frequence de stokage en pas de temps 226 224 ncum=dt_cum/dt_app … … 311 309 312 310 c Declarations des champs avec dimension verticale 313 c print*,'1HISTDEF'311 c PRINT*,'1HISTDEF' 314 312 do iQ=1,nQ 315 313 do itr=1,ntr … … 322 320 enddo 323 321 c Declarations pour les fonctions de courant 324 c print*,'2HISTDEF'322 c PRINT*,'2HISTDEF' 325 323 CALL histdef(fileid,'psi'//nom(iQ) 326 324 . ,'stream fn. '//znoml(itot,iQ), … … 331 329 332 330 c Declarations pour les champs de transport d'air 333 c print*,'3HISTDEF'331 c PRINT*,'3HISTDEF' 334 332 CALL histdef(fileid, 'masse', 'masse', 335 333 . 'kg', 1, jjn, thoriid, llm, 1, llm, zvertiid, … … 339 337 . 32, 'ave(X)', dt_cum, dt_cum) 340 338 c Declarations pour les fonctions de courant 341 c print*,'4HISTDEF'339 c PRINT*,'4HISTDEF' 342 340 CALL histdef(fileid,'psi','stream fn. MMC ','mega t/s', 343 341 . 1,jjn,thoriid,llm,1,llm,zvertiid, … … 346 344 347 345 c Declaration des champs 1D de transport en latitude 348 c print*,'5HISTDEF'346 c PRINT*,'5HISTDEF' 349 347 do iQ=1,nQ 350 348 do itr=2,ntr … … 356 354 357 355 358 c print*,'8HISTDEF'356 c PRINT*,'8HISTDEF' 359 357 CALL histend(fileid) 360 358 … … 687 685 !$OMP BARRIER 688 686 689 c print*,'3OK'687 c PRINT*,'3OK' 690 688 c -------------------------------------------------------------- 691 689 c calcul de la moyenne zonale du transport : … … 728 726 zvQtmp(:,l)=0. 729 727 do j=jjb,jje 730 c print*,'j,l,iQ=',j,l,iQ728 c PRINT*,'j,l,iQ=',j,l,iQ 731 729 c Calcul des moyennes zonales du transort total et de zvQtmp 732 730 do i=1,iim … … 739 737 zvQ(j,l,iave,iQ)=zvQ(j,l,iave,iQ)+zqy 740 738 enddo 741 c print*,'aOK'739 c PRINT*,'aOK' 742 740 c Decomposition 743 741 zvQ(j,l,iave,iQ)=zvQ(j,l,iave,iQ)/zmasse(j,l) … … 775 773 !$OMP BARRIER 776 774 777 c print*,'4OK'775 c PRINT*,'4OK' 778 776 c sorties proprement dites 779 777 !$OMP MASTER -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/call_dissip_mod.f90
r5101 r5103 107 107 CALL suspend_timer(timer_caldyn) 108 108 109 ! print*,'Entree dans la dissipation : Iteration No ',true_itau109 ! PRINT*,'Entree dans la dissipation : Iteration No ',true_itau 110 110 ! calcul de l'energie cinetique avant dissipation 111 111 ! print *,'Passage dans la dissipation' -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/conf_gcm.F90
r5101 r5103 2 2 ! $Id$ 3 3 4 SUBROUTINE conf_gcm( tapedef, etatinit ) 4 SUBROUTINE conf_gcm( tapedef, etatinit )conf_gcm 5 5 6 6 USE control_mod 7 #ifdef CPP_IOIPSL8 7 USE IOIPSL 9 #else10 ! if not using IOIPSL, we still need to use (a local version of) getin11 USE ioipsl_getincom12 #endif13 8 USE misc_mod 14 9 USE mod_filtre_fft, ONLY: use_filtre_fft … … 101 96 ENDIF 102 97 103 adjust=. false.98 adjust=.FALSE. 104 99 CALL getin('adjust',adjust) 105 100 … … 186 181 !Config Def = n 187 182 !Config Help = Reinit des variables de controle 188 resetvarc = . false.183 resetvarc = .FALSE. 189 184 CALL getin('resetvarc',resetvarc) 190 185 … … 257 252 !Config Def = n 258 253 !Config Help = output dynamics diagnostics in Grads-readable 'dyn.dat' file 259 output_grads_dyn=. false.254 output_grads_dyn=.FALSE. 260 255 CALL getin('output_grads_dyn',output_grads_dyn) 261 256 … … 358 353 359 354 ! mode_top_bound : fields towards which sponge relaxation will be done: 360 ! top_bound sponge: only active if ok_strato=. true. and iflag_top_bound!=0355 ! top_bound sponge: only active if ok_strato=.TRUE. and iflag_top_bound!=0 361 356 ! iflag_top_bound=0 for no sponge 362 357 ! iflag_top_bound=1 for sponge over 4 topmost layers … … 409 404 !Config Help = y: intialize dynamical fields using a 'start.nc' file 410 405 ! n: fields are initialized by 'iniacademic' routine 411 read_start= . true.406 read_start= .TRUE. 412 407 CALL getin('read_start',read_start) 413 408 … … 515 510 !Config Desc = Fonction hyperbolique 516 511 !Config Def = y 517 !Config Help = Fonction f(y) hyperbolique si = . true.512 !Config Help = Fonction f(y) hyperbolique si = .TRUE. 518 513 !Config sinon sinusoidale 519 514 fxyhypbb = .TRUE. … … 605 600 !Config Desc = Fonction en Sinus 606 601 !Config Def = y 607 !Config Help = Fonction f(y) avec y = Sin(latit.) si = . true.602 !Config Help = Fonction f(y) avec y = Sin(latit.) si = .TRUE. 608 603 !Config sinon y = latit. 609 604 ysinuss = .TRUE. … … 800 795 !Config Desc = Fonction hyperbolique 801 796 !Config Def = y 802 !Config Help = Fonction f(y) hyperbolique si = . true.797 !Config Help = Fonction f(y) hyperbolique si = .TRUE. 803 798 !Config sinon sinusoidale 804 799 fxyhypb = .TRUE. … … 841 836 !Config Desc = Fonction en Sinus 842 837 !Config Def = y 843 !Config Help = Fonction f(y) avec y = Sin(latit.) si = . true.838 !Config Help = Fonction f(y) avec y = Sin(latit.) si = .TRUE. 844 839 !Config sinon y = latit. 845 840 ysinus = .TRUE. -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.F
r5086 r5103 84 84 85 85 CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, 86 & 2, 2, . true., 1)86 & 2, 2, .TRUE., 1) 87 87 88 88 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90
r5101 r5103 4 4 ! Write the NetCDF restart file (initialization). 5 5 !------------------------------------------------------------------------------- 6 #ifdef CPP_IOIPSL7 6 USE IOIPSL 8 #endif9 7 USE parallel_lmdz 10 8 USE mod_hallo … … 53 51 IF(mpi_rank/=0) RETURN 54 52 55 #ifdef CPP_IOIPSL56 53 CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian) 57 54 CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours) 58 #else59 ! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)60 yyears0=061 mmois0=162 jjour0=163 #endif64 55 65 56 tab_cntrl(:) = 0. -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90
r5101 r5103 56 56 57 57 INTEGER ije, ijb, jje, jjb 58 logical, save :: firstcall = . true.58 logical, save :: firstcall = .TRUE. 59 59 !$OMP THREADPRIVATE(firstcall) 60 60 character(len = *), parameter :: modname = "exner_hyb_loc" … … 76 76 endif ! of if (llm.eq.1) 77 77 78 firstcall = . false.78 firstcall = .FALSE. 79 79 endif ! of if (firstcall) 80 80 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90
r5101 r5103 51 51 52 52 INTEGER ije,ijb,jje,jjb 53 logical,save :: firstcall=. true.53 logical,save :: firstcall=.TRUE. 54 54 !$OMP THREADPRIVATE(firstcall) 55 55 character(len=*),parameter :: modname="exner_milieu_loc" … … 69 69 endif ! of if (llm.eq.1) 70 70 71 firstcall=. false.71 firstcall=.FALSE. 72 72 endif ! of if (firstcall) 73 73 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/friction_loc.F
r5101 r5103 6 6 USE parallel_lmdz 7 7 USE control_mod 8 #ifdef CPP_IOIPSL9 8 USE IOIPSL 10 #else11 ! if not using IOIPSL, we still need to use (a local version of) getin12 USE ioipsl_getincom13 #endif14 9 USE comconst_mod, ONLY: pi 15 10 IMPLICIT NONE … … 45 40 INTEGER i,j,l 46 41 REAL,PARAMETER :: cfric=1.e-5 47 LOGICAL,SAVE :: firstcall=. true.42 LOGICAL,SAVE :: firstcall=.TRUE. 48 43 INTEGER,SAVE :: friction_type=1 49 44 CHARACTER(len=20) :: modname="friction_p" … … 61 56 CALL abort_gcm(modname,abort_message,42) 62 57 endif 63 firstcall=. false.58 firstcall=.FALSE. 64 59 ENDIF 65 60 !$OMP END SINGLE COPYPRIVATE(friction_type,firstcall) -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90
r5101 r5103 4 4 PROGRAM gcm 5 5 6 #ifdef CPP_IOIPSL7 6 USE IOIPSL 8 #endif9 7 10 8 USE mod_const_mpi, ONLY: init_const_mpi … … 175 173 ! calend = 'earth_365d' 176 174 177 #ifdef CPP_IOIPSL178 175 if (calend == 'earth_360d') then 179 176 CALL ioconf_calendar('360_day') … … 192 189 CALL abort_gcm(modname,abort_message,1) 193 190 endif 194 #endif195 191 196 192 … … 326 322 ! endif 327 323 328 #ifdef CPP_IOIPSL329 324 mois = 1 330 325 heure = 0. … … 341 336 write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure' 342 337 write(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref 343 #else344 ! Ehouarn: we still need to define JD_ref and JH_ref345 ! and since we don't know how many days there are in a year346 ! we set JD_ref to 0 (this should be improved ...)347 jD_ref=0348 jH_ref=0349 #endif350 338 351 339 if (iflag_phys==1) then … … 390 378 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//) 391 379 392 #ifdef CPP_IOIPSL393 380 CALL ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure) 394 381 write (lunout,301)jour, mois, an … … 397 384 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4) 398 385 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4) 399 #endif400 386 401 387 !----------------------------------------------------------------------- … … 428 414 ecripar = .TRUE. 429 415 430 #define CPP_IOIPSL431 #ifdef CPP_IOIPSL432 416 time_step = zdtvr 433 417 if (ok_dyn_ins) then 434 418 ! initialize output file for instantaneous outputs 435 419 ! t_ops = iecri * daysec ! do operations every t_ops 436 t_ops =((1.0*iecri)/day_step) * daysec 420 t_ops =((1.0*iecri)/day_step) * daysec 437 421 t_wrt = daysec ! iecri * daysec ! write output every t_wrt 438 422 CALL inithist_loc(day_ref,annee_ref,time_step, & … … 440 424 endif 441 425 442 IF (ok_dyn_ave) THEN 426 IF (ok_dyn_ave) THEN 443 427 ! initialize output file for averaged outputs 444 428 t_ops = iperiod * time_step ! do operations every t_ops … … 447 431 END IF 448 432 dtav = iperiod*dtvr/daysec 449 #endif450 #undef CPP_IOIPSL451 433 452 434 ! setting up DYN3D/XIOS inerface … … 455 437 mois, jour, heure, zdtvr) 456 438 endif 457 458 ! #endif of #ifdef CPP_IOIPSL459 439 460 440 !----------------------------------------------------------------------- -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/getparam.F90
r5101 r5103 3 3 4 4 MODULE getparam 5 #ifdef CPP_IOIPSL6 5 USE IOIPSL 7 #else8 ! if not using IOIPSL, we still need to use (a local version of) getin9 USE ioipsl_getincom10 #endif11 6 12 7 INTERFACE getpar -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90
r5101 r5103 1 subroutinegroupe_loc(pext, pbaru, pbarv, pbarum, pbarvm, wm)1 SUBROUTINE groupe_loc(pext, pbaru, pbarv, pbarum, pbarvm, wm) 2 2 USE parallel_lmdz 3 3 USE Write_field_loc … … 124 124 125 125 return 126 end subroutinegroupe_loc126 END SUBROUTINE groupe_loc 127 127 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
r5101 r5103 92 92 CALL ini_getparam("nudging_parameters_out.txt") 93 93 ! Variables guidees 94 CALL getpar('guide_u',. true.,guide_u,'guidage de u')95 CALL getpar('guide_v',. true.,guide_v,'guidage de v')96 CALL getpar('guide_T',. true.,guide_T,'guidage de T')97 CALL getpar('guide_P',. true.,guide_P,'guidage de P')98 CALL getpar('guide_Q',. true.,guide_Q,'guidage de Q')99 CALL getpar('guide_hr',. true.,guide_hr,'guidage de Q par H.R')100 CALL getpar('guide_teta',. false.,guide_teta,'guidage de T par Teta')101 102 CALL getpar('guide_add',. false.,guide_add,'foréage constant?')103 CALL getpar('guide_zon',. false.,guide_zon,'guidage moy zonale')94 CALL getpar('guide_u',.TRUE.,guide_u,'guidage de u') 95 CALL getpar('guide_v',.TRUE.,guide_v,'guidage de v') 96 CALL getpar('guide_T',.TRUE.,guide_T,'guidage de T') 97 CALL getpar('guide_P',.TRUE.,guide_P,'guidage de P') 98 CALL getpar('guide_Q',.TRUE.,guide_Q,'guidage de Q') 99 CALL getpar('guide_hr',.TRUE.,guide_hr,'guidage de Q par H.R') 100 CALL getpar('guide_teta',.FALSE.,guide_teta,'guidage de T par Teta') 101 102 CALL getpar('guide_add',.FALSE.,guide_add,'foréage constant?') 103 CALL getpar('guide_zon',.FALSE.,guide_zon,'guidage moy zonale') 104 104 if (guide_zon .and. abs(grossismx - 1.) > 0.01) & 105 105 CALL abort_gcm("guide_init", & … … 117 117 CALL getpar('tau_min_P',0.02,tau_min_P,'Cste de rappel min, P') 118 118 CALL getpar('tau_max_P', 10.,tau_max_P,'Cste de rappel max, P') 119 CALL getpar('gamma4',. false.,gamma4,'Zone sans rappel elargie')120 CALL getpar('guide_BL',. true.,guide_BL,'guidage dans C.Lim')119 CALL getpar('gamma4',.FALSE.,gamma4,'Zone sans rappel elargie') 120 CALL getpar('guide_BL',.TRUE.,guide_BL,'guidage dans C.Lim') 121 121 CALL getpar('plim_guide_BL',85000.,plim_guide_BL,'BL top presnivs value') 122 122 123 123 ! Sauvegarde du forçage 124 CALL getpar('guide_sav',. false.,guide_sav,'sauvegarde guidage')124 CALL getpar('guide_sav',.FALSE.,guide_sav,'sauvegarde guidage') 125 125 CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage') 126 126 ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois. … … 134 134 135 135 ! Guidage regional seulement (sinon constant ou suivant le zoom) 136 CALL getpar('guide_reg',. false.,guide_reg,'guidage regional')136 CALL getpar('guide_reg',.FALSE.,guide_reg,'guidage regional') 137 137 CALL getpar('lat_min_g',-90.,lat_min_g,'Latitude mini guidage ') 138 138 CALL getpar('lat_max_g', 90.,lat_max_g,'Latitude maxi guidage ') … … 154 154 CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage') 155 155 ! Pour compatibilite avec ancienne version avec guide_modele 156 CALL getpar('guide_modele',. false.,guide_modele,'niveaux pression ap+bp*psol')156 CALL getpar('guide_modele',.FALSE.,guide_modele,'niveaux pression ap+bp*psol') 157 157 IF (guide_modele) THEN 158 158 guide_plevs=1 159 159 ENDIF 160 160 !FC 161 CALL getpar('convert_Pa',. true.,convert_Pa,'Convert Pressure levels in Pa')161 CALL getpar('convert_Pa',.TRUE.,convert_Pa,'Convert Pressure levels in Pa') 162 162 ! Fin raccord 163 CALL getpar('ini_anal',. false.,ini_anal,'Etat initial = analyse')164 CALL getpar('guide_invertp',. true.,invert_p,'niveaux p inverses')165 CALL getpar('guide_inverty',. true.,invert_y,'inversion N-S')166 CALL getpar('guide_2D',. false.,guide_2D,'fichier guidage lat-P')163 CALL getpar('ini_anal',.FALSE.,ini_anal,'Etat initial = analyse') 164 CALL getpar('guide_invertp',.TRUE.,invert_p,'niveaux p inverses') 165 CALL getpar('guide_inverty',.TRUE.,invert_y,'inversion N-S') 166 CALL getpar('guide_2D',.FALSE.,guide_2D,'fichier guidage lat-P') 167 167 168 168 CALL fin_getparam … … 2366 2366 2367 2367 !=========================================================================== 2368 subroutinecorrectbid(iim,nl,x)2368 SUBROUTINE correctbid(iim,nl,x) 2369 2369 integer iim,nl 2370 2370 real x(iim+1,nl) … … 2376 2376 if(abs(x(i,l))>1.e10) then 2377 2377 zz=0.5*(x(i-1,l)+x(i+1,l)) 2378 print*,'correction ',i,l,x(i,l),zz2378 PRINT*,'correction ',i,l,x(i,l),zz 2379 2379 x(i,l)=zz 2380 2380 endif … … 2382 2382 enddo 2383 2383 return 2384 end subroutinecorrectbid2384 END SUBROUTINE correctbid 2385 2385 2386 2386 … … 2389 2389 !==================================================================== 2390 2390 2391 subroutinedump2du(var,varname)2391 SUBROUTINE dump2du(var,varname) 2392 2392 use parallel_lmdz 2393 2393 use mod_hallo … … 2416 2416 2417 2417 return 2418 end subroutinedump2du2418 END SUBROUTINE dump2du 2419 2419 2420 2420 !==================================================================== 2421 2421 ! Ascii debug output. Could be reactivated 2422 2422 !==================================================================== 2423 subroutinedumpall2423 SUBROUTINE dumpall 2424 2424 implicit none 2425 2425 include "dimensions.h" … … 2431 2431 CALL dump2du(ugui1(ijb_u:ije_u,1)*sqrt(unscu2(ijb_u:ije_u)),' ugui1 couche 1') 2432 2432 return 2433 end subroutinedumpall2433 END SUBROUTINE dumpall 2434 2434 2435 2435 !=========================================================================== -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90
r5101 r5103 10 10 use exner_milieu_m, only: exner_milieu 11 11 USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v 12 #ifdef CPP_IOIPSL13 12 USE IOIPSL, ONLY: getin 14 #else15 ! if not using IOIPSL, we still need to use (a local version of) getin16 USE ioipsl_getincom, ONLY: getin17 #endif18 13 USE Write_Field 19 14 USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm … … 83 78 84 79 REAL zdtvr, tnat, alpha_ideal 85 LOGICAL,PARAMETER :: tnat1=. true.80 LOGICAL,PARAMETER :: tnat1=.TRUE. 86 81 87 82 character(len=*),parameter :: modname="iniacademic" … … 94 89 write(lunout,*) "You most likely want an aquaplanet initialisation", & 95 90 " (iflag_phys >= 100)" 96 CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==. false.",1)91 CALL abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.FALSE.",1) 97 92 endif 98 93 … … 128 123 CALL inifilr 129 124 130 ! Initialize pressure and mass field if read_start=. false.125 ! Initialize pressure and mass field if read_start=.FALSE. 131 126 IF (.NOT. read_start) THEN 132 127 ! allocate global fields: … … 169 164 !------------------------------------------------------------------ 170 165 171 print*,'relief=',minval(relief),maxval(relief),'g=',g166 PRINT*,'relief=',minval(relief),maxval(relief),'g=',g 172 167 do j=1,jjp1 173 168 do i=1,iip1 … … 175 170 enddo 176 171 enddo 177 print*,'phis=',minval(phis),maxval(phis),'g=',g172 PRINT*,'phis=',minval(phis),maxval(phis),'g=',g 178 173 179 174 CALL pression ( ip1jmp1, ap, bp, ps_glo, p ) … … 225 220 CALL getin('delt_z',delt_z) 226 221 ! Polar vortex 227 ok_pv=. false.222 ok_pv=.FALSE. 228 223 CALL getin('ok_pv',ok_pv) 229 224 phi_pv=-50. ! Latitude of edge of vortex -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.F
r5101 r5103 2 2 ! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 3 3 4 subroutine initdynav_loc(day0,anne0,tstep,t_ops,t_wrt) 5 6 #ifdef CPP_IOIPSL 4 SUBROUTINE initdynav_loc(day0,anne0,tstep,t_ops,t_wrt) 5 7 6 ! This routine needs IOIPSL 8 7 USE IOIPSL 9 #endif10 8 USE parallel_lmdz 11 9 use Write_field … … 56 54 real tstep, t_ops, t_wrt 57 55 58 #ifdef CPP_IOIPSL59 56 ! This routine needs IOIPSL 60 57 C Variables locales … … 78 75 INTEGER,DIMENSION(2) :: dpl 79 76 INTEGER,DIMENSION(2) :: dhs 80 INTEGER,DIMENSION(2) :: dhe 81 77 INTEGER,DIMENSION(2) :: dhe 78 82 79 INTEGER :: dynhistave_domain_id 83 80 INTEGER :: dynhistvave_domain_id 84 81 INTEGER :: dynhistuave_domain_id 85 82 86 83 if (adjust) return 87 84 … … 92 89 C 93 90 C Appel a histbeg: creation du fichier netcdf et initialisations diverses 94 C 91 C 95 92 96 93 zan = anne0 … … 98 95 CALL ymds2ju(zan, 1, dayref, 0.0, zjulian) 99 96 tau0 = itau_dyn 100 97 101 98 do jj = 1, jjp1 102 99 do ii = 1, iip1 … … 109 106 ! Creation de 3 fichiers pour les differentes grilles horizontales 110 107 ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier 111 ! Grille Scalaire 108 ! Grille Scalaire 112 109 113 110 jjb=jj_begin … … 126 123 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 127 124 . 'box',dynhistave_domain_id) 128 125 129 126 CALL histbeg(dynhistave_file,iip1, rlong(:,1), jjn, 130 127 . rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, … … 143 140 IF (pole_sud) jjn=jjn-1 144 141 IF (pole_sud) jje=jje-1 145 142 146 143 do jj = jjb, jje 147 144 do ii = 1, iip1 … … 167 164 . zjulian, tstep, vhoriid, 168 165 . histvaveid,dynhistvave_domain_id) 169 166 170 167 ! Grille U 171 168 … … 192 189 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 193 190 . 'box',dynhistuave_domain_id) 194 191 195 192 CALL histbeg(dynhistuave_file,iip1, rlong(:,1), jjn, 196 193 . rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, 197 194 . zjulian, tstep, uhoriid, 198 195 . histuaveid,dynhistuave_domain_id) 199 200 196 197 201 198 C 202 199 C Appel a histvert pour la grille verticale … … 281 278 CALL histend(histuaveid) 282 279 CALL histend(histvaveid) 283 #else284 write(lunout,*)'initdynav_loc: Needs IOIPSL to function'285 #endif286 ! #endif of #ifdef CPP_IOIPSL287 280 end -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.F
r5101 r5103 2 2 ! $Id$ 3 3 4 subroutineinitfluxsto_p4 SUBROUTINE initfluxsto_p 5 5 . (infile,tstep,t_ops,t_wrt, 6 6 . fileid,filevid,filedid) 7 7 8 #ifdef CPP_IOIPSL9 8 ! This routine needs IOIPSL 10 9 USE IOIPSL 11 #endif12 10 USE parallel_lmdz 13 11 use Write_field … … 58 56 integer fileid, filevid,filedid 59 57 60 #ifdef CPP_IOIPSL61 58 ! This routine needs IOIPSL 62 59 C Variables locales … … 83 80 INTEGER,DIMENSION(2) :: dpl 84 81 INTEGER,DIMENSION(2) :: dhs 85 INTEGER,DIMENSION(2) :: dhe 86 82 INTEGER,DIMENSION(2) :: dhe 83 87 84 INTEGER :: dynu_domain_id 88 85 INTEGER :: dynv_domain_id … … 94 91 str='q ' 95 92 ctrac = 'traceur ' 96 ok_sync = . true.93 ok_sync = .TRUE. 97 94 C 98 95 C Appel a histbeg: creation du fichier netcdf et initialisations diverses 99 C 96 C 100 97 101 98 zan = annee_ref … … 103 100 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian) 104 101 tau0 = itau_dyn 105 102 106 103 do jj = 1, jjp1 107 104 do ii = 1, iip1 … … 125 122 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 126 123 . 'box',dynu_domain_id) 127 124 128 125 CALL histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje), 129 126 . 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, … … 131 128 C 132 129 C Creation du fichier histoire pour la grille en V (oblige pour l'instant, 133 C IOIPSL ne permet pas de grilles avec des nombres de point differents dans 130 C IOIPSL ne permet pas de grilles avec des nombres de point differents dans 134 131 C un meme fichier) 135 132 … … 158 155 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, 159 156 . 'box',dynv_domain_id) 160 157 161 158 CALL histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje), 162 159 . 1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid, 163 160 . filevid,dynv_domain_id) 164 161 165 162 rl(1,1) = 1. 166 163 167 164 if (mpi_rank==0) then 168 165 169 166 CALL histbeg('defstoke.nc', 1, rl, 1, rl, 170 167 . 1, 1, 1, 1, 171 168 . tau0, zjulian, tstep, dhoriid, filedid) 172 169 173 170 endif 174 171 C … … 188 185 CALL histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje), 189 186 . 'scalar','Grille points scalaires', thoriid) 190 187 191 188 C 192 189 C Appel a histvert pour la grille verticale … … 208 205 C 209 206 C Appels a histdef pour la definition des variables a sauvegarder 210 207 211 208 CALL histdef(fileid, "phis", "Surface geop. height", "-", 212 209 . iip1,jjn,thoriid, 1,1,1, -99, 32, … … 216 213 . iip1,jjn,thoriid, 1,1,1, -99, 32, 217 214 . "once", t_ops, t_wrt) 218 215 219 216 if (mpi_rank==0) then 220 217 221 218 CALL histdef(filedid, "dtvr", "tps dyn", "s", 222 219 . 1,1,dhoriid, 1,1,1, -99, 32, 223 220 . "once", t_ops, t_wrt) 224 221 225 222 CALL histdef(filedid, "istdyn", "tps stock", "s", 226 223 . 1,1,dhoriid, 1,1,1, -99, 32, 227 224 . "once", t_ops, t_wrt) 228 225 229 226 CALL histdef(filedid, "istphy", "tps stock phy", "s", 230 227 . 1,1,dhoriid, 1,1,1, -99, 32, … … 233 230 endif 234 231 C 235 C Masse 232 C Masse 236 233 C 237 234 CALL histdef(fileid, 'masse', 'Masse', 'kg', … … 239 236 . 32, 'inst(X)', t_ops, t_wrt) 240 237 C 241 C Pbaru 238 C Pbaru 242 239 C 243 240 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', … … 246 243 247 244 C 248 C Pbarv 245 C Pbarv 249 246 C 250 247 if (pole_sud) jjn=jj_nb-1 251 248 252 249 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', 253 250 . iip1, jjn, vhoriid, llm, 1, llm, zvertiid, 254 251 . 32, 'inst(X)', t_ops, t_wrt) 255 252 C 256 C w 253 C w 257 254 C 258 255 if (pole_sud) jjn=jj_nb … … 270 267 271 268 C 272 C Geopotentiel 269 C Geopotentiel 273 270 C 274 271 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', … … 286 283 if (mpi_rank==0) CALL histsync(filedid) 287 284 endif 288 289 #else 290 write(lunout,*)'initfluxsto_p: Needs IOIPSL to function' 291 #endif 292 ! #endif of #ifdef CPP_IOIPSL 285 293 286 return 294 287 end -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90
r5101 r5103 1 1 ! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 2 2 3 subroutine inithist_loc(day0, anne0, tstep, t_ops, t_wrt) 4 5 #ifdef CPP_IOIPSL 3 SUBROUTINE inithist_loc(day0, anne0, tstep, t_ops, t_wrt) 4 6 5 ! This routine needs IOIPSL 7 6 USE IOIPSL 8 #endif9 7 USE parallel_lmdz 10 8 use Write_field … … 53 51 real :: tstep, t_ops, t_wrt 54 52 55 #ifdef CPP_IOIPSL56 53 ! This routine needs IOIPSL 57 54 ! Variables locales … … 280 277 CALL histend(histuid) 281 278 CALL histend(histvid) 282 #else 283 write(lunout, *)'inithist_loc: Needs IOIPSL to function' 284 #endif 285 ! #endif of #ifdef CPP_IOIPSL 286 end subroutine inithist_loc 279 END SUBROUTINE inithist_loc -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.F
r5101 r5103 15 15 USE comvert_mod, ONLY: ap, bp 16 16 USE temps_mod, ONLY: dt 17 USE strings_mod, ONLY: int2str 17 18 18 19 IMPLICIT NONE -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90
r5101 r5103 9 9 USE mod_hallo 10 10 USE Bands 11 USE Write_Field11 USE strings_mod, ONLY: int2str 12 12 USE Write_Field_p 13 13 USE vampir … … 39 39 xios_set_current_context, & 40 40 using_xios 41 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_ INCA, CPPKEY_DEBUGIO41 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO 42 42 43 43 IMPLICIT NONE … … 153 153 LOGICAL :: first, callinigrads 154 154 155 data callinigrads/. true./155 data callinigrads/.TRUE./ 156 156 character(len = 10) :: string10 157 157 … … 182 182 PARAMETER (testita = 9) 183 183 184 logical, parameter :: flag_verif = . false.184 logical, parameter :: flag_verif = .FALSE. 185 185 186 186 ! declaration liees au parallelisme … … 211 211 iapptrac = 0 212 212 AdjustCount = 0 213 lafin = . false.213 lafin = .FALSE. 214 214 215 215 if (nday>=0) then … … 224 224 225 225 itau = 0 226 physic = . true.227 if (iflag_phys==0.or.iflag_phys==2) physic = . false.226 physic = .TRUE. 227 if (iflag_phys==0.or.iflag_phys==2) physic = .FALSE. 228 228 CALL init_nan 229 229 CALL leapfrog_allocate … … 317 317 CALL check_isotopes(q, ijb_u, ije_u, 'leapfrog 321') 318 318 319 #ifdef CPP_IOIPSL320 319 if (ok_guide) then 321 320 CALL guide_main(itau,ucov,vcov,teta,q,masse,ps) 322 321 !$OMP BARRIER 323 322 endif 324 #endif325 323 326 324 … … 402 400 ItCount = ItCount + 1 403 401 if (MOD(ItCount, 1)==1) then 404 debug = . true.402 debug = .TRUE. 405 403 else 406 debug = . false.404 debug = .FALSE. 407 405 endif 408 406 !$OMP END MASTER … … 451 449 ! supress dissipation step 452 450 if (llm==1) then 453 apdiss = . false.451 apdiss = .FALSE. 454 452 endif 455 453 … … 808 806 if (FirstPhysic) then 809 807 ok_start_timer = .TRUE. 810 FirstPhysic = . false.808 FirstPhysic = .FALSE. 811 809 endif 812 810 !$OMP END MASTER … … 820 818 if (FirstPhysic) then 821 819 ok_start_timer = .TRUE. 822 FirstPhysic = . false.820 FirstPhysic = .FALSE. 823 821 endif 824 822 !$OMP END MASTER … … 952 950 ! ! set ok_guide to false to avoid extra output 953 951 ! ! in following forward step 954 ok_guide = . false.952 ok_guide = .FALSE. 955 953 endif 956 954 957 IF (CPPKEY_INCA) THEN958 955 IF (ANY(type_trac == ['inca', 'inco'])) THEN 959 956 CALL finalize_inca … … 965 962 !$OMP END MASTER 966 963 ENDIF 967 END IF968 964 #ifdef REPROBUS 969 965 if (type_trac == 'repr') CALL finalize_reprobus … … 1011 1007 !$OMP END MASTER 1012 1008 1013 IF (CPPKEY_INCA) THEN1014 1009 IF (ANY(type_trac == ['inca', 'inco'])) THEN 1015 1010 CALL finalize_inca … … 1021 1016 !$OMP END MASTER 1022 1017 ENDIF 1023 END IF1024 1018 #ifdef REPROBUS 1025 1019 if (type_trac == 'repr') CALL finalize_reprobus … … 1052 1046 !$OMP BARRIER 1053 1047 1054 #ifdef CPP_IOIPSL1055 1048 IF (ok_dynzon) THEN 1056 1049 … … 1064 1057 ucov,teta,pk,phi,q,masse,ps,phis) 1065 1058 ENDIF 1066 #endif1067 1059 1068 1060 ENDIF … … 1084 1076 !$OMP BARRIER 1085 1077 1086 #ifdef CPP_IOIPSL1087 1078 if (ok_dyn_ins) then 1088 1079 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, & 1089 1080 masse,ps,phis) 1090 1081 endif 1091 #endif1092 1082 1093 1083 IF (ok_dyn_xios) THEN … … 1116 1106 ! ! set ok_guide to false to avoid extra output 1117 1107 ! ! in following forward step 1118 ok_guide = . false.1108 ok_guide = .FALSE. 1119 1109 endif 1120 1110 … … 1180 1170 !$OMP END MASTER 1181 1171 1182 IF (CPPKEY_INCA) THEN1183 1172 IF (ANY(type_trac == ['inca', 'inco'])) THEN 1184 1173 CALL finalize_inca … … 1190 1179 !$OMP END MASTER 1191 1180 ENDIF 1192 1193 END IF1194 1181 #ifdef REPROBUS 1195 1182 if (type_trac == 'repr') CALL finalize_reprobus … … 1216 1203 ENDIF 1217 1204 1218 #ifdef CPP_IOIPSL1219 1205 ! ! Ehouarn: re-compute geopotential for outputs 1220 1206 !$OMP BARRIER … … 1233 1219 ucov,teta,pk,phi,q,masse,ps,phis) 1234 1220 ENDIF 1235 #endif1236 1221 1237 1222 ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) … … 1246 1231 1247 1232 1248 #ifdef CPP_IOIPSL1249 1233 if (ok_dyn_ins) then 1250 1234 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, & 1251 1235 masse,ps,phis) 1252 1236 endif ! of if (ok_dyn_ins) 1253 #endif1254 1237 1255 1238 IF (ok_dyn_xios) THEN … … 1272 1255 ! ! set ok_guide to false to avoid extra output 1273 1256 ! ! in following forward step 1274 ok_guide = . false.1257 ok_guide = .FALSE. 1275 1258 endif 1276 1259 … … 1289 1272 !$OMP END MASTER 1290 1273 1291 IF (CPPKEY_INCA) THEN1292 1274 IF (ANY(type_trac == ['inca', 'inco'])) THEN 1293 1275 CALL finalize_inca … … 1299 1281 !$OMP END MASTER 1300 1282 ENDIF 1301 END IF1302 1283 #ifdef REPROBUS 1303 1284 if (type_trac == 'repr') CALL finalize_reprobus -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_call_calfis.F90
r5101 r5103 81 81 USE control_mod 82 82 USE write_field_loc 83 USE write_field83 USE strings_mod, ONLY: int2str 84 84 USE comconst_mod, ONLY: dtphys 85 85 USE logic_mod, ONLY: leapf, forward, ok_strato … … 93 93 94 94 INTEGER, INTENT(IN) :: itau ! (time) iteration step number 95 LOGICAL, INTENT(IN) :: lafin ! . true. if final time step95 LOGICAL, INTENT(IN) :: lafin ! .TRUE. if final time step 96 96 REAL, INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u, llm) ! covariant zonal wind 97 97 REAL, INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v, llm) ! covariant meridional wind -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_const_mpi.F90
r5101 r5103 13 13 USE lmdz_mpi 14 14 15 #ifdef CPP_IOIPSL16 15 USE IOIPSL, ONLY: getin 17 #else18 ! if not using IOIPSL, we still need to use (a local version of) getin19 USE ioipsl_getincom, only: getin20 #endif21 16 ! Use of Oasis-MCT coupler 22 17 #ifdef CPP_OMCT -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_hallo.F90
r5101 r5103 67 67 contains 68 68 69 subroutineInit_mod_hallo69 SUBROUTINE Init_mod_hallo 70 70 USE dimensions_mod 71 71 USE IOIPSL … … 96 96 !$OMP BARRIER 97 97 98 end subroutineinit_mod_hallo98 END SUBROUTINE init_mod_hallo 99 99 100 100 SUBROUTINE create_standard_mpi_buffer … … 137 137 138 138 139 subroutineallocate_buffer(Size,Index,Pos)139 SUBROUTINE allocate_buffer(Size,Index,Pos) 140 140 implicit none 141 141 integer :: Size … … 159 159 Index=Index_Pos 160 160 161 end subroutineallocate_buffer161 END SUBROUTINE allocate_buffer 162 162 163 subroutinedeallocate_buffer(Index)163 SUBROUTINE deallocate_buffer(Index) 164 164 implicit none 165 165 integer :: Index … … 171 171 END DO 172 172 173 end subroutine deallocate_buffer174 175 subroutineSetTag(a_request,tag)173 END SUBROUTINE deallocate_buffer 174 175 SUBROUTINE SetTag(a_request,tag) 176 176 implicit none 177 177 type(request):: a_request … … 179 179 180 180 a_request%tag=tag 181 end subroutineSetTag182 183 184 subroutineNew_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request)181 END SUBROUTINE SetTag 182 183 184 SUBROUTINE New_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request) 185 185 integer :: Stride 186 186 integer :: NbLevel … … 212 212 NewHallo%offset=offset 213 213 214 end subroutineNew_Hallo215 216 subroutineRegister_SendField(Field,ij,ll,offset,size,target,a_request)214 END SUBROUTINE New_Hallo 215 216 SUBROUTINE Register_SendField(Field,ij,ll,offset,size,target,a_request) 217 217 USE dimensions_mod 218 218 implicit none … … 228 228 CALL New_Hallo(Field,ij,ll,offset,size,Ptr_request) 229 229 230 end subroutine Register_SendField231 232 subroutineRegister_RecvField(Field,ij,ll,offset,size,target,a_request)230 END SUBROUTINE Register_SendField 231 232 SUBROUTINE Register_RecvField(Field,ij,ll,offset,size,target,a_request) 233 233 USE dimensions_mod 234 234 implicit none … … 245 245 246 246 247 end subroutine Register_RecvField248 249 subroutineRegister_SwapField(FieldS,FieldR,ij,ll,jj_Nb_New,a_request)247 END SUBROUTINE Register_RecvField 248 249 SUBROUTINE Register_SwapField(FieldS,FieldR,ij,ll,jj_Nb_New,a_request) 250 250 USE dimensions_mod 251 251 implicit none … … 291 291 enddo 292 292 293 end subroutine Register_SwapField294 295 296 297 subroutineRegister_SwapFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down,a_request)293 END SUBROUTINE Register_SwapField 294 295 296 297 SUBROUTINE Register_SwapFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down,a_request) 298 298 USE dimensions_mod 299 299 … … 344 344 enddo 345 345 346 end subroutineRegister_SwapFieldHallo346 END SUBROUTINE Register_SwapFieldHallo 347 347 348 348 … … 1147 1147 1148 1148 1149 subroutineRegister_Hallo(Field,ij,ll,RUp,Rdown,SUp,SDown,a_request)1149 SUBROUTINE Register_Hallo(Field,ij,ll,RUp,Rdown,SUp,SDown,a_request) 1150 1150 USE dimensions_mod 1151 1151 USE lmdz_mpi … … 1209 1209 ENDIF 1210 1210 1211 end subroutineRegister_Hallo1212 1213 1214 subroutineRegister_Hallo_u(Field,ll,RUp,Rdown,SUp,SDown,a_request)1211 END SUBROUTINE Register_Hallo 1212 1213 1214 SUBROUTINE Register_Hallo_u(Field,ll,RUp,Rdown,SUp,SDown,a_request) 1215 1215 USE dimensions_mod 1216 1216 USE lmdz_mpi … … 1273 1273 ENDIF 1274 1274 1275 end subroutineRegister_Hallo_u1276 1277 subroutineRegister_Hallo_v(Field,ll,RUp,Rdown,SUp,SDown,a_request)1275 END SUBROUTINE Register_Hallo_u 1276 1277 SUBROUTINE Register_Hallo_v(Field,ll,RUp,Rdown,SUp,SDown,a_request) 1278 1278 USE dimensions_mod 1279 1279 USE lmdz_mpi … … 1336 1336 ENDIF 1337 1337 1338 end subroutineRegister_Hallo_v1339 1340 subroutineSendRequest(a_Request)1338 END SUBROUTINE Register_Hallo_v 1339 1340 SUBROUTINE SendRequest(a_Request) 1341 1341 USE dimensions_mod 1342 1342 USE lmdz_mpi … … 1454 1454 enddo 1455 1455 1456 end subroutine SendRequest1457 1458 subroutineWaitRequest(a_Request)1456 END SUBROUTINE SendRequest 1457 1458 SUBROUTINE WaitRequest(a_Request) 1459 1459 USE dimensions_mod 1460 1460 USE lmdz_mpi … … 1539 1539 1540 1540 a_request%tag=1 1541 end subroutineWaitRequest1541 END SUBROUTINE WaitRequest 1542 1542 1543 subroutineWaitSendRequest(a_Request)1543 SUBROUTINE WaitSendRequest(a_Request) 1544 1544 USE lmdz_mpi 1545 1545 USE dimensions_mod … … 1587 1587 1588 1588 a_request%tag=1 1589 end subroutineWaitSendRequest1590 1591 subroutineWaitRecvRequest(a_Request)1589 END SUBROUTINE WaitSendRequest 1590 1591 SUBROUTINE WaitRecvRequest(a_Request) 1592 1592 USE dimensions_mod 1593 1593 USE lmdz_mpi … … 1656 1656 1657 1657 a_request%tag=1 1658 end subroutineWaitRecvRequest1659 1660 1661 1662 subroutineCopyField(FieldS,FieldR,ij,ll,jj_Nb_New)1658 END SUBROUTINE WaitRecvRequest 1659 1660 1661 1662 SUBROUTINE CopyField(FieldS,FieldR,ij,ll,jj_Nb_New) 1663 1663 USE dimensions_mod 1664 1664 … … 1696 1696 1697 1697 1698 end subroutine CopyField1699 1700 subroutineCopyFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down)1698 END SUBROUTINE CopyField 1699 1700 SUBROUTINE CopyFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down) 1701 1701 USE dimensions_mod 1702 1702 … … 1736 1736 1737 1737 endif 1738 end subroutine CopyFieldHallo1739 1740 subroutineGather_field_u(field_loc,field_glo,ll)1738 END SUBROUTINE CopyFieldHallo 1739 1740 SUBROUTINE Gather_field_u(field_loc,field_glo,ll) 1741 1741 USE dimensions_mod 1742 1742 implicit none … … 1759 1759 !$OMP BARRIER 1760 1760 1761 end subroutineGather_field_u1762 1763 subroutineGather_field_v(field_loc,field_glo,ll)1761 END SUBROUTINE Gather_field_u 1762 1763 SUBROUTINE Gather_field_v(field_loc,field_glo,ll) 1764 1764 USE dimensions_mod 1765 1765 implicit none … … 1787 1787 !$OMP BARRIER 1788 1788 1789 end subroutineGather_field_v1789 END SUBROUTINE Gather_field_v 1790 1790 1791 subroutineScatter_field_u(field_glo,field_loc,ll)1791 SUBROUTINE Scatter_field_u(field_glo,field_loc,ll) 1792 1792 USE dimensions_mod 1793 1793 implicit none … … 1821 1821 ENDDO 1822 1822 1823 end subroutineScatter_field_u1824 1825 subroutineScatter_field_v(field_glo,field_loc,ll)1823 END SUBROUTINE Scatter_field_u 1824 1825 SUBROUTINE Scatter_field_v(field_glo,field_loc,ll) 1826 1826 USE dimensions_mod 1827 1827 implicit none … … 1858 1858 ENDDO 1859 1859 1860 end subroutineScatter_field_v1860 END SUBROUTINE Scatter_field_v 1861 1861 1862 1862 end module mod_Hallo -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/mod_xios_dyn3dmem.F90
r5101 r5103 138 138 REAL, DIMENSION(ij_begin:ij_end) :: Field 139 139 REAL, DIMENSION(iip1, jj_begin:jj_end) :: NewField 140 LOGICAL,SAVE :: debuglf=. true.140 LOGICAL,SAVE :: debuglf=.TRUE. 141 141 !$OMP THREADPRIVATE(debuglf) 142 142 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/parallel_lmdz.F90
r5101 r5103 5 5 USE mod_const_mpi 6 6 USE lmdz_mpi, ONLY: using_mpi 7 #ifdef CPP_IOIPSL8 7 use IOIPSL 9 #else10 ! if not using IOIPSL, we still need to use (a local version of) getin11 use ioipsl_getincom12 #endif13 8 INTEGER,PARAMETER :: halo_max=3 14 9 15 LOGICAL,SAVE :: using_omp ! . true. if using OpenMP16 LOGICAL,SAVE :: is_master ! . true. if the core is both MPI & OpenMP master10 LOGICAL,SAVE :: using_omp ! .TRUE. if using OpenMP 11 LOGICAL,SAVE :: is_master ! .TRUE. if the core is both MPI & OpenMP master 17 12 !$OMP THREADPRIVATE(is_master) 18 13 … … 86 81 contains 87 82 88 subroutineinit_parallel83 SUBROUTINE init_parallel 89 84 USE vampir 90 85 USE lmdz_mpi … … 240 235 241 236 IF ((mpi_rank==0).and.(omp_rank==0)) THEN 242 is_master=. true.237 is_master=.TRUE. 243 238 ELSE 244 is_master=. false.239 is_master=.FALSE. 245 240 ENDIF 246 241 247 end subroutineinit_parallel242 END SUBROUTINE init_parallel 248 243 249 244 SUBROUTINE create_distrib(jj_nb_new,d) … … 382 377 END SUBROUTINE get_current_distrib 383 378 384 subroutineFinalize_parallel379 SUBROUTINE Finalize_parallel 385 380 USE lmdz_mpi 386 381 ! ug Pour les sorties XIOS … … 439 434 end if 440 435 441 end subroutineFinalize_parallel442 443 subroutinePack_Data(Field,ij,ll,row,Buffer)436 END SUBROUTINE Finalize_parallel 437 438 SUBROUTINE Pack_Data(Field,ij,ll,row,Buffer) 444 439 implicit none 445 440 … … 462 457 enddo 463 458 464 end subroutine Pack_data459 END SUBROUTINE Pack_data 465 460 466 subroutineUnpack_Data(Field,ij,ll,row,Buffer)461 SUBROUTINE Unpack_Data(Field,ij,ll,row,Buffer) 467 462 implicit none 468 463 … … 486 481 enddo 487 482 488 end subroutineUnPack_data483 END SUBROUTINE UnPack_data 489 484 490 485 … … 501 496 502 497 503 subroutineexchange_hallo(Field,ij,ll,up,down)498 SUBROUTINE exchange_hallo(Field,ij,ll,up,down) 504 499 USE lmdz_mpi 505 500 USE Vampir … … 616 611 RETURN 617 612 618 end subroutineexchange_Hallo619 620 621 subroutineGather_Field(Field,ij,ll,rank)613 END SUBROUTINE exchange_Hallo 614 615 616 SUBROUTINE Gather_Field(Field,ij,ll,rank) 622 617 USE lmdz_mpi 623 618 implicit none … … 696 691 ENDIF ! using_mpi 697 692 698 end subroutineGather_Field699 700 701 subroutineAllGather_Field(Field,ij,ll)693 END SUBROUTINE Gather_Field 694 695 696 SUBROUTINE AllGather_Field(Field,ij,ll) 702 697 USE lmdz_mpi 703 698 implicit none … … 715 710 ENDIF 716 711 717 end subroutineAllGather_Field718 719 subroutineBroadcast_Field(Field,ij,ll,rank)712 END SUBROUTINE AllGather_Field 713 714 SUBROUTINE Broadcast_Field(Field,ij,ll,rank) 720 715 USE lmdz_mpi 721 716 implicit none … … 734 729 735 730 ENDIF 736 end subroutineBroadcast_Field731 END SUBROUTINE Broadcast_Field 737 732 738 733 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/times.F90
r5101 r5103 2 2 integer,private,save :: Last_Count=0 3 3 real, private,save :: Last_cpuCount=0 4 logical, private,save :: AllTimer_IsActive=. false.4 logical, private,save :: AllTimer_IsActive=.FALSE. 5 5 6 6 integer, parameter :: nb_timer = 4 … … 24 24 contains 25 25 26 subroutineinit_timer26 SUBROUTINE init_timer 27 27 USE parallel_lmdz 28 28 implicit none … … 46 46 timer_delta(:,:,:)=0 47 47 timer_state(:)=stopped 48 end subroutineinit_timer49 50 subroutinestart_timer(no_timer)48 END SUBROUTINE init_timer 49 50 SUBROUTINE start_timer(no_timer) 51 51 implicit none 52 52 integer :: no_timer … … 65 65 endif 66 66 67 end subroutinestart_timer68 69 subroutinesuspend_timer(no_timer)67 END SUBROUTINE start_timer 68 69 SUBROUTINE suspend_timer(no_timer) 70 70 implicit none 71 71 integer :: no_timer … … 82 82 timer_running(no_timer)=timer_running(no_timer)+last_time(no_timer) 83 83 endif 84 end subroutinesuspend_timer85 86 subroutineresume_timer(no_timer)84 END SUBROUTINE suspend_timer 85 86 SUBROUTINE resume_timer(no_timer) 87 87 implicit none 88 88 integer :: no_timer … … 98 98 endif 99 99 100 end subroutineresume_timer101 102 subroutinestop_timer(no_timer)100 END SUBROUTINE resume_timer 101 102 SUBROUTINE stop_timer(no_timer) 103 103 USE parallel_lmdz 104 104 implicit none … … 133 133 endif 134 134 135 end subroutinestop_timer135 END SUBROUTINE stop_timer 136 136 137 subroutineallgather_timer137 SUBROUTINE allgather_timer 138 138 USE parallel_lmdz 139 139 USE lmdz_mpi … … 163 163 ENDIF ! using_mpi 164 164 165 end subroutineallgather_timer166 167 subroutineallgather_timer_average165 END SUBROUTINE allgather_timer 166 167 SUBROUTINE allgather_timer_average 168 168 USE parallel_lmdz 169 169 USE lmdz_mpi … … 195 195 196 196 ENDIF ! using_mpi 197 end subroutineallgather_timer_average198 199 subroutineInitTime197 END SUBROUTINE allgather_timer_average 198 199 SUBROUTINE InitTime 200 200 implicit none 201 201 integer :: count,count_rate,count_max … … 207 207 Last_Count=count 208 208 endif 209 end subroutineInitTime209 END SUBROUTINE InitTime 210 210 211 211 function DiffTime() -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/top_bound_loc.F
r5099 r5103 40 40 ! can be toward the average zonal field or just zero (see below). 41 41 42 ! NB: top_bound sponge is only called from leapfrog if ok_strato=. true.42 ! NB: top_bound sponge is only called from leapfrog if ok_strato=.TRUE. 43 43 44 44 ! sponge parameters: (loaded/set in conf_gcm.F ; stored in comconst_mod) … … 79 79 REAL,SAVE :: rdamp(llm) 80 80 real,save :: lambda(llm) ! inverse or quenching time scale (Hz) 81 LOGICAL,SAVE :: first=. true.81 LOGICAL,SAVE :: first=.TRUE. 82 82 INTEGER j,l,jjb,jje 83 83 … … 116 116 endif 117 117 enddo 118 first=. false.118 first=.FALSE. 119 119 c$OMP END MASTER 120 120 c$OMP BARRIER -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.F
r5101 r5103 117 117 ENDDO ! l=1,llm 118 118 c$OMP END DO NOWAIT 119 c print*,'Ok calcul des pentes'119 c PRINT*,'Ok calcul des pentes' 120 120 121 121 ELSE ! (pente_max.lt.-1.e-5) … … 162 162 ENDDO 163 163 c$OMP END DO NOWAIT 164 c print*,'Bouclage en iip1'164 c PRINT*,'Bouclage en iip1' 165 165 166 166 c calcul des flux a gauche et a droite … … 169 169 c on cumule le flux correspondant a toutes les mailles dont la masse 170 170 c au travers de la paroi pENDant le pas de temps. 171 c print*,'Cumule ....'171 c PRINT*,'Cumule ....' 172 172 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 173 173 ! on a besoin de masse entre ijb et ije 174 174 DO l=1,llm 175 175 DO ij=ijb,ije-1 176 c print*,'masse(',ij,')=',masse(ij,l,iq)176 c PRINT*,'masse(',ij,')=',masse(ij,l,iq) 177 177 IF (u_m(ij,l)>0.) THEN 178 178 zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq) … … 200 200 ENDDO 201 201 c$OMP END DO NOWAIT 202 c print*,'Ok test 1'202 c PRINT*,'Ok test 1' 203 203 204 204 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) … … 209 209 ENDDO 210 210 c$OMP END DO NOWAIT 211 c print*,'Ok test 2'211 c PRINT*,'Ok test 2' 212 212 213 213 … … 292 292 293 293 c bouclage en latitude 294 c print*,'Avant bouclage en latitude'294 c PRINT*,'Avant bouclage en latitude' 295 295 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 296 296 DO l=1,llm … … 442 442 EXTERNAL SSUM 443 443 444 DATA first/. true./444 DATA first/.TRUE./ 445 445 DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./ 446 446 INTEGER ijb,ije … … 454 454 IF(first) THEN 455 455 PRINT*,'Shema Amont nouveau appele dans Vanleer ' 456 first=. false.456 first=.FALSE. 457 457 do i=2,iip1 458 458 coslon(i)=cos(rlonv(i)) … … 954 954 955 955 countcfl=0 956 ! print*,'vlz nouveau'956 ! PRINT*,'vlz nouveau' 957 957 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 958 958 DO l = 2,llm -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltgen_loc.F90
r5101 r5103 24 24 USE parallel_lmdz 25 25 USE mod_hallo 26 USE Write_Field_loc26 USE write_field_loc, ONLY: WriteField_u, WriteField_v 27 27 USE VAMPIR 28 28 ! ! CRisi: on rajoute variables utiles d'infotrac … … 31 31 USE comconst_mod, ONLY: cpp 32 32 USE logic_mod, ONLY: adv_qsat_liq 33 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO34 33 IMPLICIT NONE 35 34 … … 170 169 ENDDO 171 170 172 ! CALL SCOPY(ijp1llm,q,1,zq,1)173 ! CALL SCOPY(ijp1llm,masse,1,zm,1)174 175 171 ijb = ij_begin 176 172 ije = ij_end … … 185 181 ENDDO 186 182 187 IF (CPPKEY_DEBUGIO) THEN188 CALL WriteField_u('mu', mu)189 CALL WriteField_v('mv', mv)190 CALL WriteField_u('mw', mw)191 CALL WriteField_u('qsat', qsat)192 END IF193 194 183 ! ! verif temporaire 195 184 ijb = ij_begin … … 202 191 IF(tracers(iq)%parent /= 'air') CYCLE 203 192 ! !write(*,*) 'vlspltgen 192: iq,iadv=',iq,tracers(iq)%iadv 204 IF (CPPKEY_DEBUGIO) THEN205 CALL WriteField_u('zq', zq(:, :, iq))206 CALL WriteField_u('zm', zm(:, :, iq))207 END IF208 193 SELECT CASE(tracers(iq)%iadv) 209 194 CASE(0); CYCLE 210 195 CASE(10) 211 #ifdef _ADV_HALO212 ! CRisi: on ajoute les nombres de fils et tableaux des fils213 ! On suppose qu'on ne peut advecter les fils que par le schéma 10.214 CALL vlx_loc(zq,pente_max,zm,mu, &215 ij_begin,ij_begin+2*iip1-1,iq)216 CALL vlx_loc(zq,pente_max,zm,mu, &217 ij_end-2*iip1+1,ij_end,iq)218 #else219 196 CALL vlx_loc(zq, pente_max, zm, mu, & 220 197 ij_begin, ij_end, iq) 221 #endif222 198 223 199 !$OMP MASTER … … 237 213 !$OMP END MASTER 238 214 CASE(14) 239 #ifdef _ADV_HALO240 CALL vlxqs_loc(zq,pente_max,zm,mu, &241 qsat,ij_begin,ij_begin+2*iip1-1,iq)242 CALL vlxqs_loc(zq,pente_max,zm,mu, &243 qsat,ij_end-2*iip1+1,ij_end,iq)244 #else245 215 CALL vlxqs_loc(zq, pente_max, zm, mu, & 246 216 qsat, ij_begin, ij_end, iq) 247 #endif248 217 249 218 !$OMP MASTER … … 295 264 CASE(0); CYCLE 296 265 CASE(10) 297 #ifdef _ADV_HALLO298 CALL vlx_loc(zq,pente_max,zm,mu, &299 ij_begin+2*iip1,ij_end-2*iip1,iq)300 #endif301 266 CASE(14) 302 #ifdef _ADV_HALLO303 CALL vlxqs_loc(zq,pente_max,zm,mu, &304 qsat,ij_begin+2*iip1,ij_end-2*iip1,iq)305 #endif306 267 CASE DEFAULT 307 268 CALL abort_gcm("vlspltgen_p", "schema non parallelise", 1) … … 336 297 do iq = 1, nqtot 337 298 IF(tracers(iq)%parent /= 'air') CYCLE 338 ! !write(*,*) 'vlspltgen 321: iq=',iq339 IF (CPPKEY_DEBUGIO) THEN340 CALL WriteField_u('zq', zq(:, :, iq))341 CALL WriteField_u('zm', zm(:, :, iq))342 END IF343 299 344 300 SELECT CASE(tracers(iq)%iadv) … … 356 312 do iq = 1, nqtot 357 313 IF(tracers(iq)%parent /= 'air') CYCLE 358 ! !write(*,*) 'vlspltgen 349: iq=',iq359 IF (CPPKEY_DEBUGIO) THEN360 CALL WriteField_u('zq', zq(:, :, iq))361 CALL WriteField_u('zm', zm(:, :, iq))362 END IF363 314 SELECT CASE(tracers(iq)%iadv) 364 315 CASE(0); CYCLE 365 316 CASE(10, 14) 366 317 !$OMP BARRIER 367 #ifdef _ADV_HALLO368 CALL vlz_loc(zq,pente_max,zm,mw, &369 ij_begin,ij_begin+2*iip1-1,iq)370 CALL vlz_loc(zq,pente_max,zm,mw, &371 ij_end-2*iip1+1,ij_end,iq)372 #else373 318 CALL vlz_loc(zq, pente_max, zm, mw, & 374 319 ij_begin, ij_end, iq) 375 #endif376 320 !$OMP BARRIER 377 321 … … 421 365 CASE(10, 14) 422 366 !$OMP BARRIER 423 424 #ifdef _ADV_HALLO425 CALL vlz_loc(zq,pente_max,zm,mw, &426 ij_begin+2*iip1,ij_end-2*iip1,iq)427 #endif428 429 !$OMP BARRIER430 367 CASE DEFAULT 431 368 CALL abort_gcm("vlspltgen_p", "schema non parallelise", 1) … … 457 394 do iq = 1, nqtot 458 395 IF(tracers(iq)%parent /= 'air') CYCLE 459 ! !write(*,*) 'vlspltgen 449: iq=',iq460 IF (CPPKEY_DEBUGIO) THEN461 CALL WriteField_u('zq', zq(:, :, iq))462 CALL WriteField_u('zm', zm(:, :, iq))463 END IF464 396 SELECT CASE(tracers(iq)%iadv) 465 397 CASE(0); CYCLE … … 476 408 do iq = 1, nqtot 477 409 IF(tracers(iq)%parent /= 'air') CYCLE 478 ! !write(*,*) 'vlspltgen 477: iq=',iq479 IF (CPPKEY_DEBUGIO) THEN480 CALL WriteField_u('zq', zq(:, :, iq))481 CALL WriteField_u('zm', zm(:, :, iq))482 END IF483 410 SELECT CASE(tracers(iq)%iadv) 484 411 CASE(0); CYCLE … … 498 425 ijb = ij_begin 499 426 ije = ij_end 500 ! !write(*,*) 'vlspltgen_loc 557' 501 !$OMP BARRIER 502 503 ! !write(*,*) 'vlspltgen_loc 559' 427 !$OMP BARRIER 428 504 429 DO iq = 1, nqtot 505 ! !write(*,*) 'vlspltgen_loc 561, iq=',iq506 IF (CPPKEY_DEBUGIO) THEN507 CALL WriteField_u('zq', zq(:, :, iq))508 CALL WriteField_u('zm', zm(:, :, iq))509 END IF510 430 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 511 431 DO l = 1, llm … … 517 437 ENDDO 518 438 !$OMP END DO NOWAIT 519 ! !write(*,*) 'vlspltgen_loc 575'520 439 521 440 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) … … 526 445 ENDDO 527 446 !$OMP END DO NOWAIT 528 ! !write(*,*) 'vlspltgen_loc 583'529 447 ENDDO !DO iq=1,nqtot 530 448 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.F
r5101 r5103 440 440 INTEGER ifils,iq2 ! CRisi 441 441 442 DATA first/. true./442 DATA first/.TRUE./ 443 443 INTEGER ijb,ije 444 444 INTEGER ijbm,ijem … … 460 460 PRINT*,'Shema Amont nouveau appele dans Vanleer ' 461 461 PRINT*,'vlyqs_loc, iq=',iq 462 first=. false.462 first=.FALSE. 463 463 do i=2,iip1 464 464 coslon(i)=cos(rlonv(i)) -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/wrgrads.f90
r5102 r5103 1 2 1 ! $Header$ 3 2 4 subroutine wrgrads(if,nl,field,name,titlevar)5 3 SUBROUTINE wrgrads(if, nl, field, name, titlevar) 4 implicit none 6 5 7 cDeclarations8 cif indice du fichier9 cnl nombre de couches10 cfield champ11 cname petit nom12 ctitlevar Titre6 ! Declarations 7 ! if indice du fichier 8 ! nl nombre de couches 9 ! field champ 10 ! name petit nom 11 ! titlevar Titre 13 12 14 13 INCLUDE "gradsdef.h" 15 14 16 carguments17 integer if,nl18 real field(imx*jmx*lmx)19 character*10 name,file20 character*10titlevar15 ! arguments 16 integer :: if, nl 17 real :: field(imx * jmx * lmx) 18 character(len = 10) :: name, file 19 character(len = 10) :: titlevar 21 20 22 clocal21 ! local 23 22 24 integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf23 integer :: im, jm, lm, i, j, l, iv, iii, iji, iif, ijf 25 24 26 logicalwritectl25 logical :: writectl 27 26 27 writectl = .FALSE. 28 28 29 writectl=.false. 29 PRINT*, if, iid(if), jid(if), ifd(if), jfd(if) 30 iii = iid(if) 31 iji = jid(if) 32 iif = ifd(if) 33 ijf = jfd(if) 34 im = iif - iii + 1 35 jm = ijf - iji + 1 36 lm = lmd(if) 30 37 31 print*,if,iid(if),jid(if),ifd(if),jfd(if) 32 iii=iid(if) 33 iji=jid(if) 34 iif=ifd(if) 35 ijf=jfd(if) 36 im=iif-iii+1 37 jm=ijf-iji+1 38 lm=lmd(if) 38 PRINT*, 'im,jm,lm,name,firsttime(if)' 39 PRINT*, im, jm, lm, name, firsttime(if) 39 40 40 print*,'im,jm,lm,name,firsttime(if)' 41 print*,im,jm,lm,name,firsttime(if) 41 if(firsttime(if)) then 42 if(name==var(1, if)) then 43 firsttime(if) = .FALSE. 44 ivar(if) = 1 45 PRINT*, 'fin de l initialiation de l ecriture du fichier' 46 PRINT*, file 47 PRINT*, 'fichier no: ', if 48 PRINT*, 'unit ', unit(if) 49 PRINT*, 'nvar ', nvar(if) 50 PRINT*, 'vars ', (var(iv, if), iv = 1, nvar(if)) 51 else 52 ivar(if) = ivar(if) + 1 53 nvar(if) = ivar(if) 54 var(ivar(if), if) = name 55 tvar(ivar(if), if) = trim(titlevar) 56 nld(ivar(if), if) = nl 57 PRINT*, 'initialisation ecriture de ', var(ivar(if), if) 58 PRINT*, 'if ivar(if) nld ', if, ivar(if), nld(ivar(if), if) 59 endif 60 writectl = .TRUE. 61 itime(if) = 1 62 else 63 ivar(if) = mod(ivar(if), nvar(if)) + 1 64 if (ivar(if)==nvar(if)) then 65 writectl = .TRUE. 66 itime(if) = itime(if) + 1 67 endif 42 68 43 if(firsttime(if)) then 44 if(name==var(1,if)) then 45 firsttime(if)=.false. 46 ivar(if)=1 47 print*,'fin de l initialiation de l ecriture du fichier' 48 print*,file 49 print*,'fichier no: ',if 50 print*,'unit ',unit(if) 51 print*,'nvar ',nvar(if) 52 print*,'vars ',(var(iv,if),iv=1,nvar(if)) 53 else 54 ivar(if)=ivar(if)+1 55 nvar(if)=ivar(if) 56 var(ivar(if),if)=name 57 tvar(ivar(if),if)=trim(titlevar) 58 nld(ivar(if),if)=nl 59 print*,'initialisation ecriture de ',var(ivar(if),if) 60 print*,'if ivar(if) nld ',if,ivar(if),nld(ivar(if),if) 61 endif 62 writectl=.true. 63 itime(if)=1 64 else 65 ivar(if)=mod(ivar(if),nvar(if))+1 66 if (ivar(if)==nvar(if)) then 67 writectl=.true. 68 itime(if)=itime(if)+1 69 endif 69 if(var(ivar(if), if)/=name) then 70 PRINT*, 'Il faut stoker la meme succession de champs a chaque' 71 PRINT*, 'pas de temps' 72 PRINT*, 'fichier no: ', if 73 PRINT*, 'unit ', unit(if) 74 PRINT*, 'nvar ', nvar(if) 75 PRINT*, 'vars ', (var(iv, if), iv = 1, nvar(if)) 76 CALL abort_gcm("wrgrads", "problem", 1) 77 endif 78 endif 70 79 71 if(var(ivar(if),if)/=name) then 72 print*,'Il faut stoker la meme succession de champs a chaque' 73 print*,'pas de temps' 74 print*,'fichier no: ',if 75 print*,'unit ',unit(if) 76 print*,'nvar ',nvar(if) 77 print*,'vars ',(var(iv,if),iv=1,nvar(if)) 78 CALL abort_gcm("wrgrads","problem",1) 79 endif 80 endif 80 PRINT*, 'ivar(if),nvar(if),var(ivar(if),if),writectl' 81 PRINT*, ivar(if), nvar(if), var(ivar(if), if), writectl 82 do l = 1, nl 83 irec(if) = irec(if) + 1 84 ! PRINT*,'Ecrit rec=',irec(if),iii,iif,iji,ijf, 85 ! s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii 86 ! s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif 87 write(unit(if) + 1, rec = irec(if)) & 88 ((field((l - 1) * imd(if) * jmd(if) + (j - 1) * imd(if) + i) & 89 , i = iii, iif), j = iji, ijf) 90 enddo 91 if (writectl) then 81 92 82 print*,'ivar(if),nvar(if),var(ivar(if),if),writectl' 83 print*,ivar(if),nvar(if),var(ivar(if),if),writectl 84 do l=1,nl 85 irec(if)=irec(if)+1 86 c print*,'Ecrit rec=',irec(if),iii,iif,iji,ijf, 87 c s (l-1)*imd(if)*jmd(if)+(iji-1)*imd(if)+iii 88 c s ,(l-1)*imd(if)*jmd(if)+(ijf-1)*imd(if)+iif 89 write(unit(if)+1,rec=irec(if)) 90 s ((field((l-1)*imd(if)*jmd(if)+(j-1)*imd(if)+i) 91 s ,i=iii,iif),j=iji,ijf) 92 enddo 93 if (writectl) then 93 file = fichier(if) 94 ! WARNING! on reecrase le fichier .ctl a chaque ecriture 95 open(unit(if), file = trim(file) // '.ctl' & 96 , form = 'formatted', status = 'unknown') 97 write(unit(if), '(a5,1x,a40)') & 98 'DSET ', '^' // trim(file) // '.dat' 94 99 95 file=fichier(if) 96 c WARNING! on reecrase le fichier .ctl a chaque ecriture 97 open(unit(if),file=trim(file)//'.ctl' 98 & ,form='formatted',status='unknown') 99 write(unit(if),'(a5,1x,a40)') 100 & 'DSET ','^'//trim(file)//'.dat' 100 write(unit(if), '(a12)') 'UNDEF 1.0E30' 101 write(unit(if), '(a5,1x,a40)') 'TITLE ', title(if) 102 CALL formcoord(unit(if), im, xd(iii, if), 1., .FALSE., 'XDEF') 103 CALL formcoord(unit(if), jm, yd(iji, if), 1., .TRUE., 'YDEF') 104 CALL formcoord(unit(if), lm, zd(1, if), 1., .FALSE., 'ZDEF') 105 write(unit(if), '(a4,i10,a30)') & 106 'TDEF ', itime(if), ' LINEAR 02JAN1987 1MO ' 107 write(unit(if), '(a4,2x,i5)') 'VARS', nvar(if) 108 do iv = 1, nvar(if) 109 ! PRINT*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)' 110 ! PRINT*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if) 111 write(unit(if), 1000) var(iv, if), nld(iv, if) - 1 / nld(iv, if) & 112 , 99, tvar(iv, if) 113 enddo 114 write(unit(if), '(a7)') 'ENDVARS' 115 ! 116 1000 format(a5, 3x, i4, i3, 1x, a39) 101 117 102 write(unit(if),'(a12)') 'UNDEF 1.0E30' 103 write(unit(if),'(a5,1x,a40)') 'TITLE ',title(if) 104 CALL formcoord(unit(if),im,xd(iii,if),1.,.false.,'XDEF') 105 CALL formcoord(unit(if),jm,yd(iji,if),1.,.true.,'YDEF') 106 CALL formcoord(unit(if),lm,zd(1,if),1.,.false.,'ZDEF') 107 write(unit(if),'(a4,i10,a30)') 108 & 'TDEF ',itime(if),' LINEAR 02JAN1987 1MO ' 109 write(unit(if),'(a4,2x,i5)') 'VARS',nvar(if) 110 do iv=1,nvar(if) 111 c print*,'if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if)' 112 c print*,if,var(iv,if),nld(iv,if),nld(iv,if)-1/nld(iv,if) 113 write(unit(if),1000) var(iv,if),nld(iv,if)-1/nld(iv,if) 114 & ,99,tvar(iv,if) 115 enddo 116 write(unit(if),'(a7)') 'ENDVARS' 117 c 118 1000 format(a5,3x,i4,i3,1x,a39) 118 close(unit(if)) 119 119 120 close(unit(if))120 endif ! writectl 121 121 122 endif ! writectl122 return 123 123 124 return 124 END SUBROUTINE wrgrads 125 125 126 END127 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_loc.F90
r5101 r5103 12 12 contains 13 13 14 subroutinewrite_field1D_u(name,Field)14 SUBROUTINE write_field1D_u(name,Field) 15 15 character(len=*) :: name 16 16 real, dimension(:) :: Field … … 18 18 CALL write_field_u_gen(name,Field,1) 19 19 20 end subroutinewrite_field1D_u20 END SUBROUTINE write_field1D_u 21 21 22 subroutinewrite_field2D_u(name,Field)22 SUBROUTINE write_field2D_u(name,Field) 23 23 implicit none 24 24 … … 30 30 CALL write_field_u_gen(name,Field,ll) 31 31 32 end subroutinewrite_field2D_u32 END SUBROUTINE write_field2D_u 33 33 34 34 … … 77 77 78 78 79 subroutinewrite_field1D_v(name,Field)79 SUBROUTINE write_field1D_v(name,Field) 80 80 character(len=*) :: name 81 81 real, dimension(:) :: Field … … 83 83 CALL write_field_v_gen(name,Field,1) 84 84 85 end subroutinewrite_field1D_v85 END SUBROUTINE write_field1D_v 86 86 87 subroutinewrite_field2D_v(name,Field)87 SUBROUTINE write_field2D_v(name,Field) 88 88 implicit none 89 89 … … 95 95 CALL write_field_v_gen(name,Field,ll) 96 96 97 end subroutinewrite_field2D_v97 END SUBROUTINE write_field2D_v 98 98 99 99 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/write_field_p.F90
r5101 r5103 8 8 contains 9 9 10 subroutinewrite_field1D_p(name,Field)10 SUBROUTINE write_field1D_p(name,Field) 11 11 USE parallel_lmdz 12 12 USE write_field … … 27 27 if (MPI_Rank==0) CALL WriteField(name,New_Field) 28 28 29 end subroutinewrite_field1D_p29 END SUBROUTINE write_field1D_p 30 30 31 subroutinewrite_field2D_p(name,Field)31 SUBROUTINE write_field2D_p(name,Field) 32 32 USE parallel_lmdz 33 33 USE write_field … … 48 48 49 49 50 end subroutinewrite_field2D_p50 END SUBROUTINE write_field2D_p 51 51 52 subroutinewrite_field3D_p(name,Field)52 SUBROUTINE write_field3D_p(name,Field) 53 53 USE parallel_lmdz 54 54 USE write_field … … 68 68 if (MPI_Rank==0) CALL WriteField(name,New_Field) 69 69 70 end subroutine write_field3D_p70 END SUBROUTINE write_field3D_p 71 71 72 72 end module write_field_p -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90
r5101 r5103 62 62 integer :: ijb,ije,jjn 63 63 LOGICAL,SAVE :: first=.TRUE. 64 LOGICAL,SAVE :: debuglf=. true.64 LOGICAL,SAVE :: debuglf=.TRUE. 65 65 !$OMP THREADPRIVATE(debuglf) 66 66 !$OMP THREADPRIVATE(first) -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.F
r5101 r5103 2 2 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 3 3 4 subroutinewritedynav_loc( time, vcov, ucov,teta,ppk,phi,q,4 SUBROUTINE writedynav_loc( time, vcov, ucov,teta,ppk,phi,q, 5 5 . masse,ps,phis) 6 6 7 #ifdef CPP_IOIPSL8 7 ! This routine needs IOIPSL 9 8 USE ioipsl 10 #endif11 9 USE parallel_lmdz 12 10 USE misc_mod … … 63 61 64 62 65 #ifdef CPP_IOIPSL66 63 ! This routine needs IOIPSL 67 64 C Variables locales … … 70 67 INTEGER :: iq, ii, ll 71 68 REAL,SAVE,ALLOCATABLE :: tm(:,:) 72 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:) 69 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:) 73 70 logical ok_sync 74 71 integer itau_w … … 81 78 C 82 79 if (adjust) return 83 80 84 81 IF (first) THEN 85 82 !$OMP BARRIER 86 83 !$OMP MASTER 87 84 ALLOCATE(unat(ijb_u:ije_u,llm)) 88 ALLOCATE(vnat(ijb_v:ije_v,llm)) 85 ALLOCATE(vnat(ijb_v:ije_v,llm)) 89 86 ALLOCATE(tm(ijb_u:ije_u,llm)) 90 87 ALLOCATE(ndex2d(ijnb_u*llm)) … … 98 95 first=.FALSE. 99 96 ENDIF 100 97 101 98 ok_sync = .TRUE. 102 99 itau_w = itau_dyn + time … … 111 108 C 112 109 113 !$OMP BARRIER 110 !$OMP BARRIER 114 111 !$OMP MASTER 115 112 ijb=ij_begin 116 113 ije=ij_end 117 114 jjn=jj_nb 118 115 119 116 CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:), 120 117 . iip1*jjn*llm, ndexu) 121 !$OMP END MASTER 118 !$OMP END MASTER 122 119 123 120 C … … 128 125 if (pole_sud) ije=ij_end-iip1 129 126 !$OMP BARRIER 130 !$OMP MASTER 127 !$OMP MASTER 131 128 CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:), 132 129 . iip1*jjn*llm, ndexv) 133 !$OMP END MASTER 130 !$OMP END MASTER 134 131 135 132 … … 140 137 ije=ij_end 141 138 jjn=jj_nb 142 !$OMP MASTER 139 !$OMP MASTER 143 140 CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:), 144 141 . iip1*jjn*llm, ndexu) 145 !$OMP END MASTER 142 !$OMP END MASTER 146 143 147 144 C … … 149 146 C 150 147 151 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 148 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 152 149 do ll=1,llm 153 150 do ii = ijb, ije … … 157 154 !$OMP ENDDO 158 155 159 !$OMP MASTER 156 !$OMP MASTER 160 157 CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:), 161 158 . iip1*jjn*llm, ndexu) … … 166 163 C Geopotentiel 167 164 C 168 !$OMP MASTER 165 !$OMP MASTER 169 166 CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:), 170 167 . iip1*jjn*llm, ndexu) … … 175 172 C Traceurs 176 173 C 177 !!$OMP MASTER 174 !!$OMP MASTER 178 175 ! DO iq=1,nqtot 179 176 ! CALL histwrite(histaveid, tracers(iq)%longName, itau_w, & … … 186 183 C Masse 187 184 C 188 !$OMP MASTER 185 !$OMP MASTER 189 186 CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:), 190 187 . iip1*jjn*llm, ndexu) … … 195 192 C Pression au sol 196 193 C 197 !$OMP MASTER 194 !$OMP MASTER 198 195 199 196 CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), … … 204 201 C Geopotentiel au sol 205 202 C 206 !$OMP MASTER 203 !$OMP MASTER 207 204 ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije), 208 205 ! . iip1*jjn, ndex2d) … … 212 209 C Fin 213 210 C 214 !$OMP MASTER 211 !$OMP MASTER 215 212 if (ok_sync) then 216 213 CALL histsync(histaveid) … … 219 216 ENDIF 220 217 !$OMP END MASTER 221 #else222 write(lunout,*)'writedynav_loc: Needs IOIPSL to function'223 #endif224 ! #endif of #ifdef CPP_IOIPSL225 218 end -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.F
r5101 r5103 2 2 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 3 3 4 subroutinewritehist_loc( time, vcov, ucov,teta,ppk,phi,q,4 SUBROUTINE writehist_loc( time, vcov, ucov,teta,ppk,phi,q, 5 5 . masse,ps,phis) 6 6 7 #ifdef CPP_IOIPSL8 7 ! This routine needs IOIPSL 9 8 USE ioipsl 10 #endif11 9 USE parallel_lmdz 12 10 USE misc_mod … … 63 61 64 62 65 #ifdef CPP_IOIPSL66 63 ! This routine needs IOIPSL 67 64 C Variables locales … … 70 67 INTEGER :: iq, ii, ll 71 68 REAL,SAVE,ALLOCATABLE :: tm(:,:) 72 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:) 69 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:) 73 70 logical ok_sync 74 71 integer itau_w … … 81 78 C 82 79 if (adjust) return 83 80 84 81 IF (first) THEN 85 82 !$OMP BARRIER 86 83 !$OMP MASTER 87 84 ALLOCATE(unat(ijb_u:ije_u,llm)) 88 ALLOCATE(vnat(ijb_v:ije_v,llm)) 85 ALLOCATE(vnat(ijb_v:ije_v,llm)) 89 86 ALLOCATE(tm(ijb_u:ije_u,llm)) 90 87 ALLOCATE(ndex2d(ijnb_u*llm)) … … 98 95 first=.FALSE. 99 96 ENDIF 100 97 101 98 ok_sync = .TRUE. 102 99 itau_w = itau_dyn + time … … 111 108 C 112 109 113 !$OMP BARRIER 110 !$OMP BARRIER 114 111 !$OMP MASTER 115 112 ijb=ij_begin 116 113 ije=ij_end 117 114 jjn=jj_nb 118 115 119 116 CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije,:), 120 117 . iip1*jjn*llm, ndexu) 121 !$OMP END MASTER 118 !$OMP END MASTER 122 119 123 120 C … … 128 125 if (pole_sud) ije=ij_end-iip1 129 126 !$OMP BARRIER 130 !$OMP MASTER 127 !$OMP MASTER 131 128 CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije,:), 132 129 . iip1*jjn*llm, ndexv) 133 !$OMP END MASTER 130 !$OMP END MASTER 134 131 135 132 … … 140 137 ije=ij_end 141 138 jjn=jj_nb 142 !$OMP MASTER 139 !$OMP MASTER 143 140 CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije,:), 144 141 . iip1*jjn*llm, ndexu) 145 !$OMP END MASTER 142 !$OMP END MASTER 146 143 147 144 C … … 149 146 C 150 147 151 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 148 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 152 149 do ll=1,llm 153 150 do ii = ijb, ije … … 157 154 !$OMP ENDDO 158 155 159 !$OMP MASTER 156 !$OMP MASTER 160 157 CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije,:), 161 158 . iip1*jjn*llm, ndexu) … … 166 163 C Geopotentiel 167 164 C 168 !$OMP MASTER 165 !$OMP MASTER 169 166 CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije,:), 170 167 . iip1*jjn*llm, ndexu) … … 175 172 C Traceurs 176 173 C 177 !!$OMP MASTER 174 !!$OMP MASTER 178 175 ! DO iq=1,nqtot 179 176 ! CALL histwrite(histid, tracers(iq)%longName, itau_w, … … 186 183 C Masse 187 184 C 188 !$OMP MASTER 185 !$OMP MASTER 189 186 CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije,:), 190 187 . iip1*jjn*llm, ndexu) … … 195 192 C Pression au sol 196 193 C 197 !$OMP MASTER 194 !$OMP MASTER 198 195 CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), 199 196 . iip1*jjn, ndex2d) … … 203 200 C Geopotentiel au sol 204 201 C 205 !$OMP MASTER 202 !$OMP MASTER 206 203 ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije), 207 204 ! . iip1*jjn, ndex2d) … … 211 208 C Fin 212 209 C 213 !$OMP MASTER 210 !$OMP MASTER 214 211 if (ok_sync) then 215 212 CALL histsync(histid) … … 218 215 endif 219 216 !$OMP END MASTER 220 #else221 write(lunout,*)'writehist_loc: Needs IOIPSL to function'222 #endif223 ! #endif of #ifdef CPP_IOIPSL224 217 end
Note: See TracChangeset
for help on using the changeset viewer.
