Changeset 3435 for LMDZ6/trunk
- Timestamp:
- Jan 22, 2019, 4:21:59 PM (6 years ago)
- Location:
- LMDZ6/trunk
- Files:
-
- 7 added
- 69 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/DefLists/context_lmdz.xml
r3309 r3435 25 25 <!-- Define domains and groups of domains --> 26 26 <domain_definition> 27 <domain id="dom_glo" data_dim="2" /> 27 28 <domain id="dom_glo" data_dim="1" /> 29 30 <domain id="greordered" domain_ref="dom_glo"> 31 <reorder_domain invert_lat="true" shift_lon_fraction="0.5" min_lon="0" max_lon="360" /> 32 </domain> 33 34 <domain id="dom_regular" ni_glo="144" nj_glo="142" type="rectilinear" > 35 <generate_rectilinear_domain/> 36 <interpolate_domain order="1"/> 37 </domain> 38 39 <domain id="dom_out" domain_ref="dom_glo"/> 40 28 41 </domain_definition> 29 42 … … 42 55 <!-- Define groups of vertical axes --> 43 56 <axis_definition> 44 <axis id="presnivs" standard_name="Vertical levels" unit="Pa"> 45 </axis> 46 <axis id="Ahyb" standard_name="Ahyb comp of Hyb Cord" unit="Pa"> 47 </axis> 48 <axis id="Bhyb" standard_name="Bhyb comp of Hyb Cord" unit=""> 49 </axis> 50 <axis id="Ahyb_inter" standard_name="A comp of Hyb Cord at interface" unit="Pa"> 51 </axis> 52 <axis id="Bhyb_inter" standard_name="B comp of Hyb Cord at interface" unit=""> 53 </axis> 54 <axis id="Alt" standard_name="Height approx for scale heigh of 8km at levels" unit="km"> 55 </axis> 56 <axis id="plev" standard_name="model_level_number" unit="Pa"> 57 </axis> 58 <axis id="klev" prec="8" long_name = "hybrid sigma pressure coordinate" 59 standard_name ="atmosphere_hybrid_sigma_pressure_coordinate" unit="1"> 60 </axis> 61 <axis id="bnds" standard_name="bounds" unit="1" > 57 <axis id="time_month" n_glo="12" value="(0,11) [1 2 3 4 5 6 7 8 9 10 11 12]"/> 58 <axis id="time_year" unit="day" /> 59 <axis id="presnivs" standard_name="Vertical levels" unit="Pa"/> 60 <axis id="Ahyb" standard_name="Ahyb comp of Hyb Cord" unit="Pa"/> 61 <axis id="Bhyb" standard_name="Bhyb comp of Hyb Cord" unit=""/> 62 <axis id="Ahyb_inter" standard_name="A comp of Hyb Cord at interface" unit="Pa"/> 63 <axis id="Bhyb_inter" standard_name="B comp of Hyb Cord at interface" unit=""/> 64 <axis id="Alt" standard_name="Height approx for scale heigh of 8km at levels" unit="km"/> 65 <axis id="plev" standard_name="model_level_number" unit="Pa"/> 66 <axis id="klev" prec="8" long_name="number of layers" standard_name="number of layers" unit="1" /> 67 <axis id="klevp1" prec="8" long_name="number of layer interfaces" standard_name="number of layer interfaces" unit="1" /> 68 <axis id="bnds" standard_name="bounds" unit="1" /> 69 <axis id="spectband" standard_name="Sensor Band Central Radiation Wavenumber" unit="m-1"/> 70 <axis id="axis_lat" standard_name="Latitude axis"> 71 <reduce_domain operation="average" direction="iDir" /> 62 72 </axis> 63 73 <axis id="spectband" standard_name="Sensor Band Central Radiation Wavenumber" unit="m-1"> … … 97 107 98 108 <grid id="klev_bnds"> <axis axis_ref="klev" /> <axis axis_ref="bnds" /> </grid> 109 <grid id="klevp1_bnds"> <axis axis_ref="klevp1" /> <axis axis_ref="bnds" /> </grid> 99 110 100 111 <grid id="grid_glo"> 101 <domain id="dom_glo" /> 102 </grid> 112 <domain domain_ref="dom_glo" /> 113 </grid> 114 115 <grid id="grid_out"> 116 <domain domain_ref="dom_out" /> 117 </grid> 118 103 119 104 120 <grid id="grid_glo_presnivs"> 105 <domain id="dom_glo" /> 106 <axis id="presnivs" /> 107 </grid> 108 121 <domain domain_ref="dom_glo" /> 122 <axis axis_ref="presnivs" /> 123 </grid> 124 125 <grid id="grid_out_presnivs"> 126 <domain domain_ref="dom_out" /> 127 <axis axis_ref="presnivs" /> 128 </grid> 109 129 110 130 <grid id="grid_glo_plev"> 111 <domain id="dom_glo" /> 112 <axis id="plev" /> 113 </grid> 131 <domain domain_ref="dom_glo" /> 132 <axis axis_ref="plev" /> 133 </grid> 134 135 <grid id="grid_out_plev"> 136 <domain domain_ref="dom_out" /> 137 <axis axis_ref="plev" /> 138 </grid> 139 114 140 115 141 <grid id="grid_glo_spectband"> 116 <domain id="dom_glo" /> 117 <axis id="spectband" /> 118 </grid> 142 <domain domain_ref="dom_glo" /> 143 <axis axis_ref="spectband" /> 144 </grid> 145 146 <grid id="grid_out_spectband"> 147 <domain domain_ref="dom_out" /> 148 <axis axis_ref="spectband" /> 149 </grid> 150 119 151 120 152 <grid id="grid_glo_height"> 121 <domain id="dom_glo" /> 122 <axis id="height" /> 153 <domain domain_ref="dom_glo" /> 154 <axis axis_ref="height" /> 155 </grid> 156 157 <grid id="grid_out_height"> 158 <domain domain_ref="dom_out" /> 159 <axis axis_ref="height" /> 123 160 </grid> 124 161 125 162 <grid id="grid_glo_heightmlev"> 126 <domain id="dom_glo" /> 127 <axis id="height_mlev" /> 163 <domain domain_ref="dom_glo" /> 164 <axis axis_ref="height_mlev" /> 165 </grid> 166 167 <grid id="grid_out_heightmlev"> 168 <domain domain_ref="dom_out" /> 169 <axis axis_ref="height_mlev" /> 128 170 </grid> 129 171 130 172 <grid id="grid_glo_temp"> 131 <domain id="dom_glo" /> 132 <axis id="temp" /> 173 <domain domain_ref="dom_glo" /> 174 <axis axis_ref="temp" /> 175 </grid> 176 177 <grid id="grid_gloout_temp"> 178 <domain domain_ref="dom_out" /> 179 <axis axis_ref="temp" /> 133 180 </grid> 134 181 135 182 <grid id="grid_glo_sza"> 136 <domain id="dom_glo" /> 137 <axis id="sza" /> 183 <domain domain_ref="dom_glo" /> 184 <axis axis_ref="sza" /> 185 </grid> 186 187 <grid id="grid_out_sza"> 188 <domain domain_ref="dom_out" /> 189 <axis axis_ref="sza" /> 138 190 </grid> 139 191 140 192 <grid id="grid_glo_column"> 141 <domain id="dom_glo" /> 142 <axis id="column" /> 193 <domain domain_ref="dom_glo" /> 194 <axis axis_ref="column" /> 195 </grid> 196 197 <grid id="grid_out_column"> 198 <domain domain_ref="dom_out" /> 199 <axis axis_ref="column" /> 143 200 </grid> 144 201 -
LMDZ6/trunk/arch/arch-X64_IRENE.fcm
r3304 r3435 11 11 %DEV_FFLAGS -fp-model strict -p -g -O2 -traceback -fp-stack-check 12 12 %DEBUG_FFLAGS -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv 13 #%DEBUG_FFLAGS -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan 13 14 %MPI_FFLAGS 14 15 %OMP_FFLAGS -qopenmp -
LMDZ6/trunk/libf/dyn3d/gcm.F90
r2622 r3435 241 241 'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT' 242 242 if (.not.read_start) then 243 annee_ref=anneeref 243 244 CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0) 244 245 endif … … 377 378 tetagdiv, tetagrot , tetatemp, vert_prof_dissip) 378 379 380 ! numero de stockage pour les fichiers de redemarrage: 381 382 !----------------------------------------------------------------------- 383 ! Initialisation des I/O : 384 ! ------------------------ 385 386 387 if (nday>=0) then 388 day_end = day_ini + nday 389 else 390 day_end = day_ini - nday/day_step 391 endif 392 WRITE(lunout,300)day_ini,day_end 393 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//) 394 395 #ifdef CPP_IOIPSL 396 call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure) 397 write (lunout,301)jour, mois, an 398 call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure) 399 write (lunout,302)jour, mois, an 400 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4) 401 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4) 402 #endif 403 379 404 !----------------------------------------------------------------------- 380 405 ! Initialisation de la physique : … … 391 416 #endif 392 417 ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100)) 393 394 ! numero de stockage pour les fichiers de redemarrage:395 396 !-----------------------------------------------------------------------397 ! Initialisation des I/O :398 ! ------------------------399 400 401 if (nday>=0) then402 day_end = day_ini + nday403 else404 day_end = day_ini - nday/day_step405 endif406 WRITE(lunout,300)day_ini,day_end407 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)408 409 #ifdef CPP_IOIPSL410 call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)411 write (lunout,301)jour, mois, an412 call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)413 write (lunout,302)jour, mois, an414 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)415 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4)416 #endif417 418 418 419 ! if (planet_type.eq."earth") then -
LMDZ6/trunk/libf/dyn3dmem/caladvtrac_mod.F90
r1907 r3435 44 44 CALL allocate_u(massem,llm,d) 45 45 CALL allocate_u(pbaruc,llm,d) 46 pbaruc(:,:)=0 46 47 CALL allocate_v(pbarvc,llm,d) 48 pbarvc(:,:)=0 47 49 CALL allocate_u(pbarug,llm,d) 48 50 CALL allocate_v(pbarvg,llm,d) -
LMDZ6/trunk/libf/dyn3dmem/call_calfis_mod.F90
r2603 r3435 52 52 CALL allocate_u(p,llmp1,d) 53 53 CALL allocate_u(pks,d) 54 pks(:)=0 54 55 CALL allocate_u(pk,llm,d) 56 pk(:,:)=0 55 57 CALL allocate_u(pkf,llm,d) 56 58 CALL allocate_u(phi,llm,d) -
LMDZ6/trunk/libf/dyn3dmem/call_dissip_mod.F90
r1987 r3435 31 31 32 32 CALL allocate_u(ucov,llm,d) 33 ucov(:,:)=0 33 34 CALL allocate_v(vcov,llm,d) 35 vcov(:,:)=0 34 36 CALL allocate_u(teta,llm,d) 35 37 CALL allocate_u(p,llmp1,d) -
LMDZ6/trunk/libf/dyn3dmem/gcm.F90
r2622 r3435 233 233 'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT' 234 234 if (.not.read_start) then 235 annee_ref=anneeref 235 236 CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0) 236 237 endif … … 368 369 369 370 !----------------------------------------------------------------------- 371 ! Initialisation des I/O : 372 ! ------------------------ 373 374 375 if (nday>=0) then 376 day_end = day_ini + nday 377 else 378 day_end = day_ini - nday/day_step 379 endif 380 381 WRITE(lunout,300)day_ini,day_end 382 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//) 383 384 #ifdef CPP_IOIPSL 385 call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure) 386 write (lunout,301)jour, mois, an 387 call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure) 388 write (lunout,302)jour, mois, an 389 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4) 390 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4) 391 #endif 392 393 !----------------------------------------------------------------------- 370 394 ! Initialisation de la physique : 371 395 ! ------------------------------- … … 381 405 ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100)) 382 406 383 384 !-----------------------------------------------------------------------385 ! Initialisation des I/O :386 ! ------------------------387 388 389 if (nday>=0) then390 day_end = day_ini + nday391 else392 day_end = day_ini - nday/day_step393 endif394 395 WRITE(lunout,300)day_ini,day_end396 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)397 398 #ifdef CPP_IOIPSL399 call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)400 write (lunout,301)jour, mois, an401 call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)402 write (lunout,302)jour, mois, an403 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)404 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4)405 #endif406 407 407 408 ! if (planet_type.eq."earth") then -
LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90
r2622 r3435 101 101 time_0=0. 102 102 day_ref=1 103 annee_ref=0103 ! annee_ref=0 104 104 105 105 im = iim -
LMDZ6/trunk/libf/dyn3dmem/integrd_mod.F90
r1907 r3435 23 23 CALL allocate_u(deltap,llm,d) 24 24 CALL allocate_u(ps,d) 25 ps(:)=0 25 26 26 27 -
LMDZ6/trunk/libf/dyn3dmem/vlsplt_loc.F
r2765 r3435 19 19 include "dimensions.h" 20 20 include "paramet.h" 21 include "iniprint.h" 21 22 c 22 23 c … … 872 873 include "dimensions.h" 873 874 include "paramet.h" 875 include "iniprint.h" 874 876 c 875 877 c … … 1027 1029 ELSE ! countcfl>=1 1028 1030 1029 PRINT*,'vlz passage dans le non local' 1031 IF (prt_level>9) THEN 1032 WRITE(lunout,*)'vlz passage dans le non local' 1033 ENDIF 1030 1034 c --------------------------------------------------------------- 1031 1035 c Debut du traitement du cas ou on viole le CFL : w > masse … … 1059 1063 c le critère 1060 1064 DO WHILE (countcfl>=1) 1061 print*,'On viole le CFL Vertical sur ',countcfl,' pts' 1065 IF (prt_level>9) THEN 1066 WRITE(lunout,*)'On viole le CFL Vertical sur ',countcfl,' pts' 1067 ENDIF 1062 1068 countcfl=0 1063 1069 -
LMDZ6/trunk/libf/dynphy_lonlat/inigeomphy_mod.F90
r2963 r3435 76 76 REAL,ALLOCATABLE,SAVE :: boundslonfi(:,:) 77 77 REAL,ALLOCATABLE,SAVE :: boundslatfi(:,:) 78 !$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi) 78 INTEGER,ALLOCATABLE,SAVE :: ind_cell_glo_fi(:) 79 !$OMP THREADPRIVATE (latfi,lonfi,cufi,cvfi,airefi,boundslonfi,boundslatfi,ind_cell_glo_fi) 79 80 80 81 ! Initialize Physics distibution and parameters and interface with dynamics … … 93 94 94 95 DO i=1,iim 96 boundslon_reg(i,east)=rlonu(i+1) 95 97 boundslon_reg(i,west)=rlonu(i) 96 boundslon_reg(i,east)=rlonu(i+1)97 98 ENDDO 98 99 … … 204 205 ALLOCATE(boundslonfi(klon_omp,4)) 205 206 ALLOCATE(boundslatfi(klon_omp,4)) 207 ALLOCATE(ind_cell_glo_fi(klon_omp)) 206 208 207 209 … … 214 216 boundslonfi(1:klon_omp,:) = boundslonfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:) 215 217 boundslatfi(1:klon_omp,:) = boundslatfi_glo(offset+klon_omp_begin:offset+klon_omp_end,:) 218 ind_cell_glo_fi(1:klon_omp)=(/ (i,i=offset+klon_omp_begin,offset+klon_omp_end) /) 216 219 217 220 ! copy over local grid longitudes and latitudes 218 221 CALL init_geometry(klon_omp,lonfi,latfi,boundslonfi,boundslatfi, & 219 airefi, cufi,cvfi)222 airefi,ind_cell_glo_fi,cufi,cvfi) 220 223 221 224 ! copy over preff , ap(), bp(), etc -
LMDZ6/trunk/libf/dynphy_lonlat/phydev/iniphysiq_mod.F90
r2588 r3435 71 71 CALL inifis(prad,pg,pr,pcpp) 72 72 73 ! Initialize dimphy module74 CALL Init_dimphy(klon_omp,nlayer)75 76 73 ! Initialize tracer names, numbers, etc. for physics 77 74 CALL init_infotrac_phy(nqtot,type_trac) -
LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90
r2941 r3435 100 100 101 101 deg2rad = pi/180.0 102 102 y(:,:,:)=0 !ym warning unitialized variable 103 103 104 ! Compute psol AND tsol, knowing phis. 104 105 !******************************************************************************* -
LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90
r3412 r3435 44 44 zmax0,fevap, rnebcon,falb_dir, wake_fip, agesno, detr_therm, pbl_tke, & 45 45 phys_state_var_init, ql_ancien, qs_ancien, prlw_ancien, prsw_ancien, & 46 prw_ancien 46 prw_ancien, sollwdown 47 47 USE comconst_mod, ONLY: pi, dtvr 48 48 … … 201 201 solsw = 165. 202 202 sollw = -53. 203 !ym warning missing init for sollwdown => set to 0 204 sollwdown = 0. 203 205 t_ancien = 273.15 204 206 q_ancien = 0. … … 315 317 ALLOCATE(zmea0(iml,jml),zstd0(iml,jml)) !--- Mean orography and std deviation 316 318 ALLOCATE(zsig0(iml,jml),zgam0(iml,jml)) !--- Slope and nisotropy 319 zsig0(:,:)=0 !ym uninitialized variable 320 zgam0(:,:)=0 !ym uninitialized variable 317 321 ALLOCATE(zthe0(iml,jml)) !--- Highest slope orientation 322 zthe0(:,:)=0 !ym uninitialized variable 318 323 ALLOCATE(zpic0(iml,jml),zval0(iml,jml)) !--- Peaks and valley heights 319 324 -
LMDZ6/trunk/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90
r3125 r3435 35 35 USE phystokenc_mod, ONLY: init_phystokenc 36 36 USE phyaqua_mod, ONLY: iniaqua 37 USE comconst_mod, ONLY: omeg, rad 37 38 #ifdef INCA 38 39 USE indice_sol_mod, ONLY: nbsrf, is_oce, is_sic, is_ter, is_lic … … 118 119 119 120 ! Initialize dimphy module (unless in 1D where it has already been done) 120 IF (klon_glo>1) CALL Init_dimphy(klon_omp,nlayer)121 ! IF (klon_glo>1) CALL Init_dimphy(klon_omp,nlayer) 121 122 122 123 ! Copy over "offline" settings … … 134 135 cu,cuvsurcv,cv,cvusurcu, & 135 136 aire,apoln,apols, & 136 aireu,airev,rlatvdyn )137 aireu,airev,rlatvdyn,rad,omeg) 137 138 END IF 138 139 -
LMDZ6/trunk/libf/misc/handle_err_m.F90
r2094 r3435 39 39 end if 40 40 end if 41 call abort_ gcm("NetCDF95 handle_err", "", 1)41 call abort_physic("NetCDF95 handle_err", "", 1) 42 42 end if 43 43 -
LMDZ6/trunk/libf/misc/wxios.F90
r3165 r3435 15 15 16 16 INTEGER, SAVE :: g_comm 17 CHARACTER(len=100), SAVE :: g_ctx_name 17 CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ" 18 18 TYPE(xios_context), SAVE :: g_ctx 19 19 !$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx) … … 136 136 g_ctx_name = xios_ctx_name 137 137 138 ! Si couple alors init fait dans cpl_init139 IF (.not. PRESENT(type_ocean)) THEN140 CALL wxios_context_init()141 ENDIF138 ! ! Si couple alors init fait dans cpl_init 139 ! IF (.not. PRESENT(type_ocean)) THEN 140 ! CALL wxios_context_init() 141 ! ENDIF 142 142 143 143 END SUBROUTINE wxios_init … … 145 145 SUBROUTINE wxios_context_init() 146 146 USE print_control_mod, ONLY : prt_level, lunout 147 !USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY147 USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY 148 148 IMPLICIT NONE 149 149 … … 152 152 !$OMP MASTER 153 153 !Initialisation du contexte: 154 CALL xios_context_initialize(g_ctx_name, g_comm) 154 !!CALL xios_context_initialize(g_ctx_name, g_comm) 155 CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY) 155 156 CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération 156 157 CALL xios_set_current_context(xios_ctx) !Activation … … 165 166 !$OMP END MASTER 166 167 END SUBROUTINE wxios_context_init 168 169 170 SUBROUTINE wxios_set_context() 171 IMPLICIT NONE 172 TYPE(xios_context) :: xios_ctx 173 174 !$OMP MASTER 175 CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération 176 CALL xios_set_current_context(xios_ctx) !Activation 177 !$OMP END MASTER 178 179 END SUBROUTINE wxios_set_context 167 180 168 181 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 203 216 CASE DEFAULT 204 217 abort_message = 'wxios_set_cal: Mauvais choix de calendrier' 205 CALL abort_ gcm('Gcm:Xios',abort_message,1)218 CALL abort_physic('Gcm:Xios',abort_message,1) 206 219 END SELECT 207 220 … … 237 250 ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!! 238 251 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 239 SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, & 240 ibegin, iend, ii_begin, ii_end, jbegin, jend, & 241 data_ni, data_ibegin, data_iend, & 242 io_lat, io_lon,is_south_pole,mpi_rank) 243 244 245 USE print_control_mod, ONLY : prt_level, lunout 246 IMPLICIT NONE 247 252 SUBROUTINE wxios_domain_param(dom_id) 253 USE dimphy, only: klon 254 USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast 255 USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, & 256 mpi_size, mpi_rank, klon_mpi, & 257 is_sequential, is_south_pole_dyn 258 USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo 259 USE print_control_mod, ONLY : prt_level, lunout 260 USE geometry_mod 261 262 IMPLICIT NONE 248 263 CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier 249 LOGICAL,INTENT(IN) :: is_sequential ! flag 250 INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes 251 INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes 252 INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes 253 INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes 254 INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain 255 INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain 256 INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row) 257 INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row) 258 INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain 259 INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain 260 INTEGER,INTENT(IN) :: data_ni 261 INTEGER,INTENT(IN) :: data_ibegin 262 INTEGER,INTENT(IN) :: data_iend 263 REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid) 264 REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid) 265 logical,intent(in) :: is_south_pole ! does this process include the south pole? 266 integer,intent(in) :: mpi_rank ! rank of process 267 264 265 REAL :: rlat_glo(klon_glo) 266 REAL :: rlon_glo(klon_glo) 267 REAL :: io_lat(nbp_lat) 268 REAL :: io_lon(nbp_lon) 269 LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI 268 270 TYPE(xios_domain) :: dom 271 INTEGER :: i 269 272 LOGICAL :: boool 270 273 271 !Masque pour les problèmes de recouvrement MPI: 272 LOGICAL :: mask(ni,nj) 274 275 276 CALL gather(latitude_deg,rlat_glo) 277 CALL bcast(rlat_glo) 278 CALL gather(longitude_deg,rlon_glo) 279 CALL bcast(rlon_glo) 280 281 !$OMP MASTER 282 io_lat(1)=rlat_glo(1) 283 io_lat(nbp_lat)=rlat_glo(klon_glo) 284 IF ((nbp_lon*nbp_lat) > 1) then 285 DO i=2,nbp_lat-1 286 io_lat(i)=rlat_glo(2+(i-2)*nbp_lon) 287 ENDDO 288 ENDIF 289 290 IF (klon_glo == 1) THEN 291 io_lon(1)=rlon_glo(1) 292 ELSE 293 io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1) 294 ENDIF 295 273 296 274 297 !On récupère le handle: 275 298 CALL xios_get_domain_handle(dom_id, dom) 276 299 277 IF (prt_level >= 10) THEN278 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo279 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend280 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end281 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))282 ENDIF283 284 300 !On parametrise le domaine: 285 CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin-1, ni=ni, type="rectilinear") 286 CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin-1, nj=nj, data_dim=2) 287 CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(ibegin:iend), latvalue_1d=io_lat(jbegin:jend)) 301 CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear") 302 CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2) 303 CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end)) 304 CALL xios_set_domain_attr("dom_out", domain_ref=dom_id) 305 288 306 !On definit un axe de latitudes pour les moyennes zonales 289 307 IF (xios_is_valid_axis("axis_lat")) THEN 290 CALL xios_set_axis_attr( "axis_lat", n_glo=n j_glo, n=nj, begin=jbegin-1, value=io_lat(jbegin:jend))308 CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end)) 291 309 ENDIF 292 310 … … 294 312 mask(:,:)=.TRUE. 295 313 if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE. 296 if (ii_end<n i) mask(ii_end+1:ni,nj) = .FALSE.314 if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE. 297 315 ! special case for south pole 298 if ((ii_end .eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.316 if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true. 299 317 IF (prt_level >= 10) THEN 300 318 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1) 301 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:, nj)=",mask(:,nj)319 WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb) 302 320 ENDIF 303 321 CALL xios_set_domain_attr_hdl(dom, mask_2d=mask) … … 311 329 IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id) 312 330 END IF 331 !$OMP END MASTER 332 313 333 END SUBROUTINE wxios_domain_param 314 334 335 336 SUBROUTINE wxios_domain_param_unstructured(dom_id) 337 USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo 338 USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo 339 USE mod_phys_lmdz_para 340 USE nrtype, ONLY : PI 341 USE ioipsl_getin_p_mod, ONLY : getin_p 342 IMPLICIT NONE 343 CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier 344 REAL :: lon_mpi(klon_mpi) 345 REAL :: lat_mpi(klon_mpi) 346 REAL :: boundslon_mpi(klon_mpi,nvertex) 347 REAL :: boundslat_mpi(klon_mpi,nvertex) 348 INTEGER :: ind_cell_glo_mpi(klon_mpi) 349 TYPE(xios_domain) :: dom 350 LOGICAL :: remap_output 351 352 CALL gather_omp(longitude*180/PI,lon_mpi) 353 CALL gather_omp(latitude*180/PI,lat_mpi) 354 CALL gather_omp(boundslon*180/PI,boundslon_mpi) 355 CALL gather_omp(boundslat*180/PI,boundslat_mpi) 356 CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi) 357 358 remap_output=.TRUE. 359 CALL getin_p("remap_output",remap_output) 360 361 !$OMP MASTER 362 CALL xios_get_domain_handle(dom_id, dom) 363 364 !On parametrise le domaine: 365 CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured") 366 CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, & 367 bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) ) 368 CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1) 369 IF (remap_output) THEN 370 CALL xios_set_domain_attr("dom_out", domain_ref="dom_regular") 371 CALL xios_set_fieldgroup_attr("dom_out", domain_ref="dom_regular") 372 CALL xios_set_fieldgroup_attr("remap_expr", expr="@this_ref") 373 ENDIF 374 !$OMP END MASTER 375 376 END SUBROUTINE wxios_domain_param_unstructured 377 378 379 380 315 381 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 316 382 ! Pour déclarer un axe vertical !!!!!!!!!!!!!!! -
LMDZ6/trunk/libf/phy_common/geometry_mod.F90
r2395 r3435 30 30 !$OMP THREADPRIVATE(cell_area) 31 31 32 INTEGER,SAVE,ALLOCATABLE :: ind_cell_glo(:) ! global indice of a local cell 33 !$OMP THREADPRIVATE(ind_cell_glo) 32 34 33 35 CONTAINS … … 35 37 SUBROUTINE init_geometry(klon,longitude_,latitude_, & 36 38 boundslon_,boundslat_, & 37 cell_area_, dx_,dy_)39 cell_area_,ind_cell_glo_,dx_,dy_) 38 40 USE mod_grid_phy_lmdz, ONLY: nvertex 39 41 USE nrtype, ONLY : PI … … 45 47 REAL,INTENT(IN) :: boundslat_(klon,nvertex) 46 48 REAL,INTENT(IN) :: cell_area_(klon) 49 INTEGER,OPTIONAL,INTENT(IN) :: ind_cell_glo_(klon) 47 50 REAL,OPTIONAL,INTENT(IN) :: dx_(klon) 48 51 REAL,OPTIONAL,INTENT(IN) :: dy_(klon) … … 55 58 ALLOCATE(boundslat(klon,nvertex)) 56 59 ALLOCATE(cell_area(klon)) 60 IF (PRESENT(ind_cell_glo_)) ALLOCATE(ind_cell_glo(klon)) 57 61 IF (PRESENT(dx_)) ALLOCATE(dx(klon)) 58 62 IF (PRESENT(dy_))ALLOCATE(dy(klon)) … … 65 69 boundslat(:,:) = boundslat_(:,:) 66 70 cell_area(:) = cell_area_(:) 71 IF (PRESENT(ind_cell_glo_)) ind_cell_glo(:) = ind_cell_glo_(:) 67 72 IF (PRESENT(dx_)) dx(:) = dx_(:) 68 73 IF (PRESENT(dy_)) dy(:) = dy_(:) -
LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_mpi_data.F90
r2429 r3435 3 3 ! 4 4 MODULE mod_phys_lmdz_mpi_data 5 ! USE mod_const_mpi6 5 7 6 INTEGER,SAVE :: ii_begin … … 36 35 INTEGER,SAVE :: mpi_size 37 36 INTEGER,SAVE :: mpi_master 38 ! INTEGER,SAVE :: mpi_root39 37 LOGICAL,SAVE :: is_mpi_root 40 38 LOGICAL,SAVE :: is_using_mpi 41 39 42 40 43 ! LOGICAL,SAVE :: is_north_pole44 ! LOGICAL,SAVE :: is_south_pole45 41 LOGICAL,SAVE :: is_north_pole_dyn 46 42 LOGICAL,SAVE :: is_south_pole_dyn … … 50 46 CONTAINS 51 47 52 ! SUBROUTINE Init_phys_lmdz_mpi_data(iim,jjp1,nb_proc,distrib)53 48 SUBROUTINE init_phys_lmdz_mpi_data(nbp, nbp_lon, nbp_lat, communicator) 54 ! USE mod_const_mpi, ONLY : COMM_LMDZ55 49 IMPLICIT NONE 56 50 #ifdef CPP_MPI 57 51 INCLUDE 'mpif.h' 58 52 #endif 59 INTEGER,INTENT( in) :: nbp60 INTEGER,INTENT( in) :: nbp_lon61 INTEGER,INTENT( in) :: nbp_lat62 INTEGER,INTENT( in) :: communicator53 INTEGER,INTENT(IN) :: nbp 54 INTEGER,INTENT(IN) :: nbp_lon 55 INTEGER,INTENT(IN) :: nbp_lat 56 INTEGER,INTENT(IN) :: communicator 63 57 64 58 INTEGER,ALLOCATABLE :: distrib(:) … … 189 183 190 184 SUBROUTINE print_module_data 191 !USE print_control_mod, ONLY: lunout185 USE print_control_mod, ONLY: lunout 192 186 IMPLICIT NONE 193 INCLUDE "iniprint.h"187 ! INCLUDE "iniprint.h" 194 188 195 189 WRITE(lunout,*) 'ii_begin =', ii_begin -
LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_data.F90
r2429 r3435 7 7 INTEGER,SAVE :: omp_rank 8 8 LOGICAL,SAVE :: is_omp_root 9 LOGICAL,SAVE :: is_omp_master ! alias of is_omp_root 9 10 LOGICAL,SAVE :: is_using_omp 10 11 LOGICAL,SAVE :: is_north_pole_phy, is_south_pole_phy … … 17 18 INTEGER,SAVE :: klon_omp_begin 18 19 INTEGER,SAVE :: klon_omp_end 19 !$OMP THREADPRIVATE(omp_rank,klon_omp,is_omp_root, klon_omp_begin,klon_omp_end)20 !$OMP THREADPRIVATE(omp_rank,klon_omp,is_omp_root,is_omp_master,klon_omp_begin,klon_omp_end) 20 21 !$OMP THREADPRIVATE(is_north_pole_phy, is_south_pole_phy) 21 22 … … 60 61 ELSE 61 62 abort_message = 'ANORMAL : OMP_MASTER /= 0' 62 CALL abort_ gcm(modname,abort_message,1)63 CALL abort_physic (modname,abort_message,1) 63 64 ENDIF 64 65 !$OMP END MASTER 65 66 is_omp_master=is_omp_root 66 67 67 68 !$OMP MASTER … … 106 107 107 108 SUBROUTINE Print_module_data 109 USE print_control_mod, ONLY: lunout 108 110 IMPLICIT NONE 109 INCLUDE "iniprint.h"111 ! INCLUDE "iniprint.h" 110 112 111 113 !$OMP CRITICAL -
LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_para.F90
r2429 r3435 49 49 SUBROUTINE Test_transfert 50 50 USE mod_grid_phy_lmdz 51 USE print_control_mod, ONLY: lunout 51 52 IMPLICIT NONE 52 INCLUDE "iniprint.h"53 ! INCLUDE "iniprint.h" 53 54 54 55 REAL :: Test_Field1d_glo(klon_glo,nbp_lev) -
LMDZ6/trunk/libf/phy_common/physics_distribution_mod.F90
r2351 r3435 10 10 nbp, nbp_lon, nbp_lat, nbp_lev, & 11 11 communicator) 12 USE mod_phys_lmdz_para, ONLY: init_phys_lmdz_para 12 USE mod_phys_lmdz_para, ONLY: init_phys_lmdz_para, klon_omp 13 13 USE mod_grid_phy_lmdz, ONLY: init_grid_phy_lmdz 14 USE dimphy, ONLY : Init_dimphy 15 USE infotrac_phy, ONLY : type_trac 16 #ifdef REPROBUS 17 USE CHEM_REP, ONLY : Init_chem_rep_phys 18 #endif 19 14 20 IMPLICIT NONE 15 21 INTEGER,INTENT(IN) :: grid_type … … 24 30 CALL init_grid_phy_lmdz(grid_type,nvertex, nbp_lon,nbp_lat,nbp_lev) 25 31 CALL init_phys_lmdz_para(nbp,nbp_lon, nbp_lat, communicator) 32 !$OMP PARALLEL 33 CALL init_dimphy(klon_omp,nbp_lev) 34 35 ! Initialization of Reprobus 36 IF (type_trac == 'repr') THEN 37 #ifdef REPROBUS 38 CALL Init_chem_rep_phys(klon_omp,nbp_lev) 39 #endif 40 END IF 41 42 !$OMP END PARALLEL 26 43 27 44 END SUBROUTINE init_physics_distribution -
LMDZ6/trunk/libf/phy_common/print_control_mod.F90
r2326 r3435 7 7 !$OMP THREADPRIVATE(lunout,prt_level,debug) 8 8 9 ! NB: Module variable Initializations done by set_print_control 10 ! routine from init_print_control_mod to avoid circular 11 ! module dependencies 12 9 13 CONTAINS 10 14 11 SUBROUTINE init_print_control 12 USE ioipsl_getin_p_mod, ONLY : getin_p 13 USE mod_phys_lmdz_para, ONLY: is_omp_root, is_master 15 SUBROUTINE set_print_control(lunout_,prt_level_,debug_) 14 16 IMPLICIT NONE 15 16 LOGICAL :: opened 17 INTEGER :: number 17 INTEGER :: lunout_ 18 INTEGER :: prt_level_ 19 LOGICAL :: debug_ 20 21 lunout = lunout_ 22 prt_level = prt_level_ 23 debug = debug_ 18 24 19 !Config Key = prt_level 20 !Config Desc = niveau d'impressions de débogage 21 !Config Def = 0 22 !Config Help = Niveau d'impression pour le débogage 23 !Config (0 = minimum d'impression) 24 prt_level = 0 25 CALL getin_p('prt_level',prt_level) 26 27 !Config Key = lunout 28 !Config Desc = unite de fichier pour les impressions 29 !Config Def = 6 30 !Config Help = unite de fichier pour les impressions 31 !Config (defaut sortie standard = 6) 32 lunout=6 33 CALL getin_p('lunout', lunout) 34 35 IF (is_omp_root) THEN 36 IF (lunout /= 5 .and. lunout /= 6) THEN 37 INQUIRE(FILE='lmdz.out_0000',OPENED=opened,NUMBER=number) 38 IF (opened) THEN 39 lunout=number 40 ELSE 41 OPEN(UNIT=lunout,FILE='lmdz.out_0000',ACTION='write', & 42 STATUS='unknown',FORM='formatted') 43 ENDIF 44 ENDIF 45 ENDIF 46 47 !Config Key = debug 48 !Config Desc = mode debogage 49 !Config Def = false 50 !Config Help = positionne le mode debogage 51 52 debug = .FALSE. 53 CALL getin_p('debug',debug) 54 55 IF (is_master) THEN 56 WRITE(lunout,*)"init_print_control: prt_level=",prt_level 57 WRITE(lunout,*)"init_print_control: lunout=",lunout 58 WRITE(lunout,*)"init_print_control: debug=",debug 59 ENDIF 60 61 END SUBROUTINE init_print_control 25 END SUBROUTINE set_print_control 62 26 63 27 END MODULE print_control_mod -
LMDZ6/trunk/libf/phydev/inifis_mod.F90
r2311 r3435 1 ! $Id :$1 ! $Id$ 2 2 MODULE inifis_mod 3 3 … … 6 6 SUBROUTINE inifis(prad, pg, pr, pcpp) 7 7 ! Initialize some physical constants and settings 8 USE print_control_mod, ONLY: init_print_control8 USE init_print_control_mod, ONLY: init_print_control 9 9 USE comcstphy, ONLY: rradius, & ! planet radius (m) 10 10 rr, & ! recuced gas constant: R/molar mass of atm -
LMDZ6/trunk/libf/phylmd/add_phys_tend_mod.F90
r2848 r3435 1 ! 2 ! $Id$ 3 ! 1 4 ! 2 5 MODULE add_phys_tend_mod … … 98 101 99 102 USE dimphy, ONLY: klon, klev 100 USE phys_state_var_mod, ONLY : dtime103 USE phys_state_var_mod, ONLY : phys_tstep 101 104 USE phys_local_var_mod, ONLY: u_seri, v_seri, ql_seri, qs_seri, q_seri, t_seri 102 105 USE phys_state_var_mod, ONLY: ftsol … … 451 454 ! ------------------------------------------------ 452 455 453 d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/ dtime454 d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/ dtime455 d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/ dtime456 d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/phys_tstep 457 d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep 458 d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep 456 459 d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) 457 460 458 d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/ dtime459 460 d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/ dtime461 d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/ dtime462 d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/ dtime463 d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/ dtime464 465 d_h_col = (zh_col(:,2)-zh_col(:,1))/ dtime461 d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep 462 463 d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/phys_tstep 464 d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/phys_tstep 465 d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep 466 d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep 467 468 d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep 466 469 467 470 end if ! end if (fl_ebil .GT. 0) … … 494 497 !====================================================================== 495 498 496 USE phys_state_var_mod, ONLY : dtime, ftsol499 USE phys_state_var_mod, ONLY : phys_tstep, ftsol 497 500 USE geometry_mod, ONLY: longitude_deg, latitude_deg 498 501 USE print_control_mod, ONLY: prt_level … … 621 624 ! ------------------------------------------------ 622 625 623 d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/ dtime624 d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/ dtime625 d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/ dtime626 d_qw_col(:) = (zqw_col(:,2)-zqw_col(:,1))/phys_tstep 627 d_ql_col(:) = (zql_col(:,2)-zql_col(:,1))/phys_tstep 628 d_qs_col(:) = (zqs_col(:,2)-zqs_col(:,1))/phys_tstep 626 629 d_qt_col(:) = d_qw_col(:) + d_ql_col(:) + d_qs_col(:) 627 630 628 d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/ dtime631 d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep 629 632 630 633 print *,'zdu ', zdu … … 632 635 print *,'d_ek_col, zek_col(2), zek_col(1) ',d_ek_col(1), zek_col(1,2), zek_col(1,1) 633 636 634 d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/ dtime635 d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/ dtime636 d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/ dtime637 d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/ dtime638 639 d_h_col = (zh_col(:,2)-zh_col(:,1))/ dtime637 d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/phys_tstep 638 d_h_qw_col(:) = (zh_qw_col(:,2)-zh_qw_col(:,1))/phys_tstep 639 d_h_ql_col(:) = (zh_ql_col(:,2)-zh_ql_col(:,1))/phys_tstep 640 d_h_qs_col(:) = (zh_qs_col(:,2)-zh_qs_col(:,1))/phys_tstep 641 642 d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep 640 643 641 644 end if ! end if (fl_ebil .GT. 0) … … 716 719 717 720 USE dimphy, ONLY: klon, klev 718 USE phys_state_var_mod, ONLY : dtime721 USE phys_state_var_mod, ONLY : phys_tstep 719 722 USE phys_state_var_mod, ONLY : topsw, toplw, solsw, sollw, rain_con, snow_con 720 723 USE geometry_mod, ONLY: longitude_deg, latitude_deg -
LMDZ6/trunk/libf/phylmd/calcul_divers.h
r2825 r3435 1 1 ! 2 ! $Header$ 2 ! $Id$ 3 ! 3 4 ! 4 5 ! Initialisations diverses au tout debut … … 14 15 15 16 ! Calcul fin de journee : total_rain, nday_rain 16 IF(MOD(itap,NINT(un_jour/ dtime)).EQ.0) THEN17 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN 17 18 ! print*,'calcul nday_rain itap ',itap 18 19 DO i = 1, klon … … 23 24 24 25 ! Initialisation fin de mois 25 IF(MOD(itap-itapm1,NINT(mth_len*un_jour/ dtime)).EQ.0) THEN26 itapm1=itapm1+NINT(mth_len*un_jour/ dtime)26 IF(MOD(itap-itapm1,NINT(mth_len*un_jour/phys_tstep)).EQ.0) THEN 27 itapm1=itapm1+NINT(mth_len*un_jour/phys_tstep) 27 28 ! print*,'initialisation itapm1 ',itapm1 28 29 ENDIF … … 35 36 t2m_max_mon=0. 36 37 ENDIF 37 IF(MOD(itap,NINT(un_jour/ dtime)).EQ.1) THEN38 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.1) THEN 38 39 zt2m_min_mon=zt2m 39 40 zt2m_max_mon=zt2m … … 45 46 ENDDO 46 47 !fin de journee 47 IF(MOD(itap,NINT(un_jour/ dtime)).EQ.0) THEN48 IF(MOD(itap,NINT(un_jour/phys_tstep)).EQ.0) THEN 48 49 t2m_min_mon=t2m_min_mon+zt2m_min_mon 49 50 t2m_max_mon=t2m_max_mon+zt2m_max_mon -
LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.F90
r3421 r3435 582 582 SUBROUTINE infocfields_init 583 583 584 USE control_mod, ONLY: planet_type584 ! USE control_mod, ONLY: planet_type 585 585 USE phys_cal_mod, ONLY : mth_cur 586 586 USE mod_synchro_omp … … 656 656 657 657 CHARACTER(len=*),parameter :: modname="infocfields" 658 659 CHARACTER(len=10),SAVE :: planet_type="earth" 658 660 659 661 !----------------------------------------------------------------------- … … 718 720 WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in 719 721 WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out 720 CALL abort_ gcm('infocfields_init','Problem in the definition of the coupling fields',1)722 CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1) 721 723 ENDIF 722 724 ENDDO !DO iq=1,nbcf … … 836 838 837 839 ALLOCATE(fields_in(klon,nbcf_in),stat=error) 838 IF (error /= 0) CALL abort_ gcm(modname,'Pb in allocation fields_in',1)840 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_in',1) 839 841 ALLOCATE(yfields_in(klon,nbcf_in),stat=error) 840 IF (error /= 0) CALL abort_ gcm(modname,'Pb in allocation yfields_in',1)842 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_in',1) 841 843 ALLOCATE(fields_out(klon,nbcf_out),stat=error) 842 IF (error /= 0) CALL abort_ gcm(modname,'Pb in allocation fields_out',1)844 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_out',1) 843 845 ALLOCATE(yfields_out(klon,nbcf_out),stat=error) 844 IF (error /= 0) CALL abort_ gcm(modname,'Pb in allocation yfields_out',1)846 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_out',1) 845 847 846 848 END SUBROUTINE infocfields_init -
LMDZ6/trunk/libf/phylmd/clesphys.h
r3327 r3435 70 70 !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC) 71 71 !IM freq_calNMC : frequences de calcul fis. hist*NMC.nc 72 !IM pasphys : pas de temps de physique (secondes)73 REAL pasphys74 72 LOGICAL ok_histNMC(3) 75 73 INTEGER levout_histNMC(3) … … 111 109 & , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce & 112 110 & , z0m_seaice,z0h_seaice & 113 & , pasphys , freq_outNMC, freq_calNMC&111 & , freq_outNMC, freq_calNMC & 114 112 & , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins & 115 113 & , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS & -
LMDZ6/trunk/libf/phylmd/coef_diff_turb_mod.F90
r3102 r3435 65 65 66 66 67 ykmm = 0 !ym missing init 68 ykmn = 0 !ym missing init 69 ykmq = 0 !ym missing init 70 71 67 72 !**************************************************************************************** 68 73 ! Calcul de coefficients de diffusion turbulent de l'atmosphere : -
LMDZ6/trunk/libf/phylmd/conf_phys_m.F90
r3420 r3435 29 29 USE mod_grid_phy_lmdz, ONLY: klon_glo 30 30 USE print_control_mod, ONLY: lunout 31 USE phys_state_var_mod, ONLY: phys_tstep 31 32 32 33 INCLUDE "conema3.h" … … 150 151 151 152 REAL,SAVE :: R_ecc_omp,R_peri_omp,R_incl_omp,solaire_omp 152 REAL :: solaire_omp_init153 REAL,SAVE :: solaire_omp_init 153 154 LOGICAL,SAVE :: ok_suntime_rrtm_omp 154 155 REAL,SAVE :: co2_ppm_omp, RCO2_omp, co2_ppm_per_omp, RCO2_per_omp … … 1030 1031 ! - 1 = stratospheric aerosols scaled from 550 nm AOD 1031 1032 ! - 2 = stratospheric aerosol properties from CMIP6 1032 !Option 2 is only available with RRTM, this is tested later on 1033 !Option 2 is only available with RRTM, this is tested later on 1033 1034 !Config Def = 0 1034 1035 !Config Help = Used in physiq.F … … 1723 1724 !Config Desc = freq_calNMC(2) = frequence de calcul fichiers histdayNMC 1724 1725 !Config Desc = freq_calNMC(3) = frequence de calcul fichiers histhfNMC 1725 !Config Def = p asphys1726 !Config Help = 1727 ! 1728 freq_calNMC_omp(1) = p asphys1729 freq_calNMC_omp(2) = p asphys1730 freq_calNMC_omp(3) = p asphys1726 !Config Def = phys_tstep 1727 !Config Help = 1728 ! 1729 freq_calNMC_omp(1) = phys_tstep 1730 freq_calNMC_omp(2) = phys_tstep 1731 freq_calNMC_omp(3) = phys_tstep 1731 1732 CALL getin('freq_calNMC',freq_calNMC_omp) 1732 1733 ! -
LMDZ6/trunk/libf/phylmd/cosp/phys_cosp.F90
r3403 r3435 354 354 !$OMP END MASTER 355 355 !$OMP BARRIER 356 debut_cosp=.false.357 356 endif ! debut_cosp 358 357 ! else … … 366 365 ! call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 367 366 !#else 368 367 if (.NOT. debut_cosp) call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 369 368 !#endif 370 369 !! … … 374 373 375 374 ! print *, 'Calling write output' 376 375 if (.NOT. debut_cosp) call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, missing_val, & 377 376 cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, & 378 377 isccp, misr, modis) … … 400 399 ! call system_clock(t1,count_rate,count_max) 401 400 ! print *,(t1-t0)*1.0/count_rate 401 if (debut_cosp) then 402 debut_cosp=.false. 403 endif 402 404 403 405 CONTAINS -
LMDZ6/trunk/libf/phylmd/cosp2/cosp_output_mod.F90
r3369 r3435 359 359 WRITE(lunout,*) 'wxios_add_vaxis cth16 numMISRHgtBins, misr_histHgtCenters ', & 360 360 numMISRHgtBins, misr_histHgtCenters 361 CALL wxios_add_vaxis("cth ", numMISRHgtBins, misr_histHgtCenters)361 CALL wxios_add_vaxis("cth16", numMISRHgtBins, misr_histHgtCenters) 362 362 363 363 WRITE(lunout,*) 'wxios_add_vaxis dbze DBZE_BINS, dbze_ax ', & -
LMDZ6/trunk/libf/phylmd/cpl_mod.F90
r3102 r3435 105 105 USE surface_data 106 106 USE indice_sol_mod 107 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 107 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo 108 108 USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy 109 109 USE print_control_mod, ONLY: lunout … … 236 236 idayref = day_ini 237 237 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 238 CALL gr _fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon,zx_lon)238 CALL grid1dTo2d_glo(rlon,zx_lon) 239 239 DO i = 1, nbp_lon 240 240 zx_lon(i,1) = rlon(i+1) 241 241 zx_lon(i,nbp_lat) = rlon(i+1) 242 242 ENDDO 243 CALL gr _fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat,zx_lat)243 CALL grid1dTo2d_glo(rlat,zx_lat) 244 244 clintocplnam="cpl_atm_tauflx" 245 245 CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),& -
LMDZ6/trunk/libf/phylmd/cv3_routines.F90
r3345 r3435 3749 3749 END DO ! cld 3750 3750 3751 !ym BIG Warning : it seems that the k loop is missing !!! 3752 !ym Strong advice to check this 3753 !ym add a k loop temporary 3754 3751 3755 ! (particular case: no detraining level is found) ! cld 3756 ! Verif merge Dynamico<<<<<<< .working 3752 3757 DO il = 1, ncum ! cld 3753 3758 IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN ! cld … … 3761 3766 END IF ! cld 3762 3767 END DO ! cld 3768 ! Verif merge Dynamico ======= 3769 ! Verif merge Dynamico DO k = i + 1, nl 3770 ! Verif merge Dynamico DO il = 1, ncum !ym k loop added ! cld 3771 ! Verif merge Dynamico IF (i<=inb(il) .AND. nent(il,i)==0 .AND. iflag(il)<=1) THEN ! cld 3772 ! Verif merge Dynamico qcond(il, i) = qcond(il, i) + (1.-ep(il,i))*clw(il, i) ! cld 3773 ! Verif merge Dynamico qtment(il, i) = qent(il,k,i) + qtment(il,i) ! cld 3774 ! Verif merge Dynamico nqcond(il, i) = nqcond(il, i) + 1. ! cld 3775 ! Verif merge Dynamico END IF ! cld 3776 ! Verif merge Dynamico END DO 3777 ! Verif merge Dynamico ENDDO ! cld 3778 ! Verif merge Dynamico >>>>>>> .merge-right.r3413 3763 3779 3764 3780 DO il = 1, ncum ! cld -
LMDZ6/trunk/libf/phylmd/cva_driver.F90
r3197 r3435 613 613 asupmaxmin1(:) = 0. 614 614 615 tvp(:, :) = 0. !ym missing init, need to have a look by developpers 616 tv(:, :) = 0. !ym missing init, need to have a look by developpers 617 615 618 DO il = 1, len 616 619 cin1(il) = -100000. -
LMDZ6/trunk/libf/phylmd/dimphy.F90
r2656 r3435 33 33 !$OMP END MASTER 34 34 ALLOCATE(zmasq(klon)) 35 zmasq=0. 35 36 36 37 END SUBROUTINE Init_dimphy -
LMDZ6/trunk/libf/phylmd/grid_noro_m.F90
r2665 r3435 1 ! 2 ! $Id$ 3 ! 1 4 MODULE grid_noro_m 2 5 ! … … 334 337 imar=assert_eq(SIZE(x),SIZE(zphi,1),SIZE(mask,1),TRIM(modname)//" imar")-1 335 338 jmar=assert_eq(SIZE(y),SIZE(zphi,2),SIZE(mask,2),TRIM(modname)//" jmar") 336 ! IF(imar/=iim) CALL abort_gcm(TRIM(modname),'imar/=iim' ,1)337 ! IF(jmar/=jjm+1) CALL abort_gcm(TRIM(modname),'jmar/=jjm+1',1)338 339 iext=imdp/10 339 340 xpi = ACOS(-1.) -
LMDZ6/trunk/libf/phylmd/ini_undefSTD.F90
r2346 r3435 55 55 56 56 IF (n==1 .AND. itap-itapm1==1 .OR. n>1 .AND. mod(itap,nint( & 57 freq_outnmc(n)/ dtime))==1) THEN57 freq_outnmc(n)/phys_tstep))==1) THEN 58 58 ! print*,'ini_undefSTD n itap',n,itap 59 59 DO k = 1, nlevstd -
LMDZ6/trunk/libf/phylmd/inifis_mod.F90
r2311 r3435 6 6 SUBROUTINE inifis(punjours, prad, pg, pr, pcpp) 7 7 ! Initialize some physical constants and settings 8 USE print_control_mod, ONLY: init_print_control, lunout 8 USE init_print_control_mod, ONLY : init_print_control 9 USE print_control_mod, ONLY: lunout 9 10 IMPLICIT NONE 10 11 -
LMDZ6/trunk/libf/phylmd/iophy.F90
r3266 r3435 18 18 #ifdef CPP_XIOS 19 19 INTERFACE histwrite_phy 20 !#ifdef CPP_XIOSnew21 20 MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios 22 !#else23 ! MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios24 !#endif25 26 21 END INTERFACE 27 22 #else … … 52 47 mpi_size, mpi_rank, klon_mpi, & 53 48 is_sequential, is_south_pole_dyn 54 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo55 49 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured 50 USE print_control_mod, ONLY: prt_level,lunout 56 51 #ifdef CPP_IOIPSL 57 52 USE ioipsl, ONLY: flio_dom_set 58 53 #endif 59 54 #ifdef CPP_XIOS 60 USE wxios, ONLY: wxios_domain_param55 use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init 61 56 #endif 62 57 IMPLICIT NONE … … 77 72 INTEGER :: data_ibegin, data_iend 78 73 79 CALL gather(rlat,rlat_glo) 80 CALL bcast(rlat_glo) 81 CALL gather(rlon,rlon_glo) 82 CALL bcast(rlon_glo) 74 #ifdef CPP_XIOS 75 CALL wxios_context_init 76 #endif 77 78 79 IF (grid_type==unstructured) THEN 80 81 #ifdef CPP_XIOS 82 CALL wxios_domain_param_unstructured("dom_glo") 83 #endif 84 85 ELSE 86 87 CALL gather(rlat,rlat_glo) 88 CALL bcast(rlat_glo) 89 CALL gather(rlon,rlon_glo) 90 CALL bcast(rlon_glo) 83 91 84 92 !$OMP MASTER … … 133 141 #endif 134 142 #ifdef CPP_XIOS 135 ! Set values for the mask: 136 IF (mpi_rank == 0) THEN 137 data_ibegin = 0 138 ELSE 139 data_ibegin = ii_begin - 1 140 ENDIF 141 142 IF (mpi_rank == mpi_size-1) THEN 143 data_iend = nbp_lon 144 ELSE 145 data_iend = ii_end + 1 146 ENDIF 147 148 IF (prt_level>=10) THEN 149 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end 150 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat 151 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 152 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 153 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn 154 ENDIF 155 156 ! Initialize the XIOS domain coreesponding to this process: 157 CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, & 158 1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end, & 159 klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend, & 160 io_lat, io_lon,is_south_pole_dyn,mpi_rank) 143 ! Set values for the mask: 144 IF (mpi_rank == 0) THEN 145 data_ibegin = 0 146 ELSE 147 data_ibegin = ii_begin - 1 148 END IF 149 150 IF (mpi_rank == mpi_size-1) THEN 151 data_iend = nbp_lon 152 ELSE 153 data_iend = ii_end + 1 154 END IF 155 156 IF (prt_level>=10) THEN 157 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end 158 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat 159 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 160 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend 161 write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn 162 ENDIF 163 164 ! Initialize the XIOS domain coreesponding to this process: 161 165 #endif 162 166 !$OMP END MASTER 167 168 #ifdef CPP_XIOS 169 CALL wxios_domain_param("dom_glo") 170 #endif 171 172 ENDIF 163 173 164 174 END SUBROUTINE init_iophy_new … … 291 301 is_sequential, klon_mpi_begin, klon_mpi_end, & 292 302 mpi_rank 293 USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat 303 USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo 294 304 USE ioipsl, ONLY: histbeg 295 305 … … 366 376 ENDDO 367 377 368 CALL gr _fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon)378 CALL grid1dTo2d_glo(rlon_glo,zx_lon) 369 379 IF ((nbp_lon*nbp_lat).GT.1) THEN 370 380 DO i = 1, nbp_lon … … 373 383 ENDDO 374 384 ENDIF 375 CALL gr _fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat)385 CALL grid1dTo2d_glo(rlat_glo,zx_lat) 376 386 377 387 DO i=1,pim … … 963 973 nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm 964 974 USE print_control_mod, ONLY: prt_level,lunout 965 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 975 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat 966 976 #ifdef CPP_XIOS 967 977 USE xios, ONLY: xios_send_field 968 978 #endif 979 USE print_control_mod, ONLY: lunout, prt_level 969 980 970 981 IMPLICIT NONE … … 1007 1018 IF (.not. ok_all_xml) THEN 1008 1019 IF (prt_level >= 10) THEN 1009 WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name) 1020 write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", & 1021 trim(var%name) 1010 1022 ENDIF 1011 1023 DO iff=iff_beg, iff_end … … 1037 1049 ENDIF 1038 1050 !$OMP MASTER 1039 CALL grid1Dto2D_mpi(buffer_omp,Field2d)1051 IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d) 1040 1052 1041 1053 ! La boucle sur les fichiers: … … 1047 1059 write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name) 1048 1060 ENDIF 1049 IF (SIZE(field) == klon) then 1061 1062 IF (grid_type==regular_lonlat) THEN 1063 IF (SIZE(field) == klon) then 1050 1064 CALL xios_send_field(var%name, Field2d) 1051 ELSE 1052 CALL xios_send_field(var%name, field) 1053 ENDIF 1065 ELSE 1066 CALL xios_send_field(var%name, field) 1067 ENDIF 1068 ELSE IF (grid_type==unstructured) THEN 1069 CALL xios_send_field(var%name, buffer_omp) 1070 ENDIF 1054 1071 IF (prt_level >= 10) THEN 1055 WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name) 1072 write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',& 1073 trim(var%name) 1056 1074 ENDIF 1057 1075 #else … … 1065 1083 IF (firstx) THEN 1066 1084 IF (prt_level >= 10) THEN 1067 WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name) 1068 WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 1085 write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',& 1086 iff,trim(var%name) 1087 write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 1069 1088 ENDIF 1070 IF (SIZE(field) == klon) then 1071 CALL xios_send_field(var%name, Field2d) 1072 ELSE 1073 CALL xios_send_field(var%name, field) 1089 IF (grid_type==regular_lonlat) THEN 1090 IF (SIZE(field) == klon) then 1091 CALL xios_send_field(var%name, Field2d) 1092 ELSE 1093 CALL xios_send_field(var%name, field) 1094 ENDIF 1095 ELSE IF (grid_type==unstructured) THEN 1096 CALL xios_send_field(var%name, buffer_omp) 1074 1097 ENDIF 1098 1075 1099 firstx=.false. 1076 1100 ENDIF … … 1085 1109 !#ifdef CPP_XIOS 1086 1110 ! IF (iff == iff_beg) THEN 1087 ! if (prt_level >= 10) then1111 ! IF (prt_level >= 10) THEN 1088 1112 ! write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field" 1089 ! endif1113 ! ENDIF 1090 1114 ! CALL xios_send_field(var%name, Field2d) 1091 1115 ! ENDIF … … 1109 1133 ENDIF ! of IF (is_sequential) 1110 1134 #ifndef CPP_IOIPSL_NO_OUTPUT 1111 IF (prt_level >= 10) THE n1135 IF (prt_level >= 10) THEN 1112 1136 write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D" 1113 1137 ENDIF … … 1141 1165 nfiles, vars_defined, clef_stations, & 1142 1166 nid_files, swaerofree_diag 1143 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1167 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured 1144 1168 #ifdef CPP_XIOS 1145 1169 USE xios, ONLY: xios_send_field … … 1206 1230 ENDIF 1207 1231 !$OMP MASTER 1208 CALL grid1Dto2D_mpi(buffer_omp,field3d)1232 IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d) 1209 1233 1210 1234 ! BOUCLE SUR LES FICHIERS … … 1213 1237 IF (ok_all_xml) THEN 1214 1238 #ifdef CPP_XIOS 1215 IF (prt_level >= 10) THEN 1216 write(lunout,*)'Dans iophy histwrite3D,var%name ',trim(var%name) 1239 IF (prt_level >= 10) THEN 1240 write(lunout,*)'Dans iophy histwrite3D,var%name ',& 1241 trim(var%name) 1242 ENDIF 1243 IF (grid_type==regular_lonlat) THEN 1244 IF (SIZE(field,1) == klon) then 1245 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1246 ELSE 1247 CALL xios_send_field(var%name, field) 1248 ENDIF 1249 ELSE IF (grid_type==unstructured) THEN 1250 CALL xios_send_field(var%name, buffer_omp(:,1:nlevx)) 1217 1251 ENDIF 1218 IF (SIZE(field,1) == klon) then 1219 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1220 ELSE 1221 CALL xios_send_field(var%name, field) 1222 ENDIF 1252 1223 1253 #else 1224 1254 CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1) … … 1230 1260 #ifdef CPP_XIOS 1231 1261 IF (firstx) THEN 1232 IF (prt_level >= 10) THE n1233 WRITE(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &1262 IF (prt_level >= 10) THEN 1263 write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', & 1234 1264 iff,nlev,klev, firstx 1235 WRITE(lunout,*)'histwrite3d_phy: call xios_send_field for ', &1265 write(lunout,*)'histwrite3d_phy: call xios_send_field for ', & 1236 1266 trim(var%name), ' with iim jjm nlevx = ', & 1237 1267 nbp_lon,jj_nb,nlevx 1238 1268 ENDIF 1239 IF (SIZE(field,1) == klon) then 1240 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1241 ELSE 1242 CALL xios_send_field(var%name, field) 1269 IF (grid_type==regular_lonlat) THEN 1270 IF (SIZE(field,1) == klon) then 1271 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) 1272 ELSE 1273 CALL xios_send_field(var%name, field) 1274 ENDIF 1275 ELSE IF (grid_type==unstructured) THEN 1276 CALL xios_send_field(var%name, buffer_omp(:,1:nlevx)) 1243 1277 ENDIF 1278 1244 1279 firstx=.false. 1245 1280 ENDIF … … 1305 1340 is_sequential, klon_mpi_begin, klon_mpi_end, & 1306 1341 jj_nb, klon_mpi, is_master 1307 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1342 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured 1308 1343 USE xios, ONLY: xios_send_field 1309 1344 USE print_control_mod, ONLY: prt_level,lunout … … 1335 1370 CALL Gather_omp(field,buffer_omp) 1336 1371 !$OMP MASTER 1372 1373 IF (grid_type==unstructured) THEN 1374 1375 CALL xios_send_field(field_name, buffer_omp) 1376 1377 ELSE 1378 1337 1379 CALL grid1Dto2D_mpi(buffer_omp,Field2d) 1338 1380 … … 1342 1384 !IF(.NOT.clef_stations(iff)) THEN 1343 1385 IF (.TRUE.) THEN 1344 ALLOCATE(index2d(nbp_lon*jj_nb))1345 ALLOCATE(fieldok(nbp_lon*jj_nb))1346 1347 1386 1348 1387 CALL xios_send_field(field_name, Field2d) … … 1365 1404 ENDDO 1366 1405 ENDIF 1367 1368 ENDIF1369 1370 DEALLOCATE(index2d)1371 DEALLOCATE(fieldok)1406 DEALLOCATE(index2d) 1407 DEALLOCATE(fieldok) 1408 1409 ENDIF 1410 ENDIF 1372 1411 !$OMP END MASTER 1373 1412 ENDIF … … 1385 1424 jj_nb, klon_mpi, is_master 1386 1425 USE xios, ONLY: xios_send_field 1387 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 1426 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured 1388 1427 USE print_control_mod, ONLY: prt_level,lunout 1389 1428 … … 1416 1455 CALL Gather_omp(field,buffer_omp) 1417 1456 !$OMP MASTER 1457 1458 IF (grid_type==unstructured) THEN 1459 1460 CALL xios_send_field(field_name, buffer_omp(:,1:nlev)) 1461 1462 ELSE 1418 1463 CALL grid1Dto2D_mpi(buffer_omp,field3d) 1419 1464 … … 1423 1468 !IF (.NOT.clef_stations(iff)) THEN 1424 1469 IF(.TRUE.)THEN 1425 ALLOCATE(index3d(nbp_lon*jj_nb*nlev)) 1426 ALLOCATE(fieldok(nbp_lon*jj_nb,nlev)) 1427 CALL xios_send_field(field_name, Field3d(:,:,1:nlev)) 1470 1471 CALL xios_send_field(field_name, Field3d(:,:,1:nlev)) 1428 1472 1429 1473 ELSE … … 1448 1492 ENDDO 1449 1493 ENDIF 1494 DEALLOCATE(index3d) 1495 DEALLOCATE(fieldok) 1450 1496 ENDIF 1451 DEALLOCATE(index3d) 1452 DEALLOCATE(fieldok) 1497 ENDIF 1453 1498 !$OMP END MASTER 1454 1499 ENDIF -
LMDZ6/trunk/libf/phylmd/iostart.F90
r3401 r3435 117 117 USE netcdf 118 118 USE dimphy 119 USE geometry_mod 119 120 USE mod_grid_phy_lmdz 120 121 USE mod_phys_lmdz_para … … 126 127 127 128 REAL :: field_glo(klon_glo,field_size) 129 REAL :: field_glo_tmp(klon_glo,field_size) 130 INTEGER :: ind_cell_glo_glo(klon_glo) 128 131 LOGICAL :: tmp_found 129 132 INTEGER :: varid 130 INTEGER :: ierr 131 132 IF (is_mpi_root .AND. is_omp_root) THEN 133 INTEGER :: ierr,i 134 135 ! IF (is_master) ALLOCATE(ind_cell_glo_glo(1:klon_glo)) 136 CALL gather(ind_cell_glo,ind_cell_glo_glo) 137 138 IF (is_master) THEN 133 139 134 140 ierr=NF90_INQ_VARID(nid_start,Field_name,varid) 135 141 136 142 IF (ierr==NF90_NOERR) THEN 137 CALL body(field_glo )143 CALL body(field_glo_tmp) 138 144 tmp_found=.TRUE. 139 145 ELSE … … 146 152 147 153 IF (tmp_found) THEN 154 IF (is_master) THEN 155 DO i=1,klon_glo 156 field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:) 157 ENDDO 158 ENDIF 148 159 CALL scatter(field_glo,field) 149 160 ENDIF … … 358 369 USE netcdf 359 370 USE dimphy 371 USE geometry_mod 360 372 USE mod_grid_phy_lmdz 361 373 USE mod_phys_lmdz_para … … 367 379 368 380 REAL :: field_glo(klon_glo,field_size) 369 INTEGER :: ierr 381 REAL :: field_glo_tmp(klon_glo,field_size) 382 ! INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:) 383 INTEGER :: ind_cell_glo_glo(klon_glo) 384 INTEGER :: ierr,i 370 385 INTEGER :: nvarid 371 386 INTEGER :: idim 372 387 373 388 374 CALL gather(field,field_glo) 375 376 IF (is_mpi_root .AND. is_omp_root) THEN 389 ! IF (is_master) ALLOCATE(ind_cell_glo_glo(klon_glo)) 390 CALL gather(ind_cell_glo,ind_cell_glo_glo) 391 392 CALL gather(field,field_glo_tmp) 393 394 IF (is_master) THEN 395 396 DO i=1,klon_glo 397 field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:) 398 ENDDO 399 377 400 378 401 IF (field_size==1) THEN -
LMDZ6/trunk/libf/phylmd/limit_read_mod.F90
r2788 r3435 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 MODULE limit_read_mod … … 31 31 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 32 32 33 34 SUBROUTINE init_limit_read(first_day) 35 USE mod_grid_phy_lmdz 36 USE surface_data 37 USE mod_phys_lmdz_para 38 #ifdef CPP_XIOS 39 USE XIOS 40 #endif 41 IMPLICIT NONE 42 INTEGER, INTENT(IN) :: first_day 43 44 45 IF ( type_ocean /= 'couple') THEN 46 IF (grid_type==unstructured) THEN 47 #ifdef CPP_XIOS 48 IF (is_omp_master) CALL xios_set_file_attr("limit_read",enabled=.TRUE.,record_offset=first_day) 49 #endif 50 ENDIF 51 ENDIF 52 53 END SUBROUTINE init_limit_read 54 33 55 SUBROUTINE limit_read_frac(itime, dtime, jour, pctsrf_new, is_modified) 34 56 ! … … 150 172 USE phys_cal_mod, ONLY : calend, year_len 151 173 USE print_control_mod, ONLY: lunout, prt_level 152 174 #ifdef CPP_XIOS 175 USE XIOS, ONLY: xios_recv_field 176 #endif 177 153 178 IMPLICIT NONE 154 179 … … 179 204 REAL, DIMENSION(klon_glo) :: rug_glo ! rugosity at global grid 180 205 REAL, DIMENSION(klon_glo) :: alb_glo ! albedo at global grid 206 207 REAL, DIMENSION(klon_mpi,nbsrf) :: pct_mpi ! fraction at global grid 208 REAL, DIMENSION(klon_mpi) :: sst_mpi ! sea-surface temperature at global grid 209 REAL, DIMENSION(klon_mpi) :: rug_mpi ! rugosity at global grid 210 REAL, DIMENSION(klon_mpi) :: alb_mpi ! albedo at global grid 211 181 212 CHARACTER(len=20) :: modname='limit_read_mod' 182 213 CHARACTER(LEN=99) :: abort_message, calendar, str … … 220 251 END IF 221 252 222 !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS 223 ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid) 253 !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS 254 IF (grid_type==unstructured) THEN 255 ierr=NF90_INQ_DIMID(nid,"time_year",ndimid) 256 ELSE 257 ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid) 258 ENDIF 224 259 ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn) 225 WRITE(abort_message,'(a,2(i 3,a))')'limit.nc records number (',nn,') does no'//&260 WRITE(abort_message,'(a,2(i0,a))')'limit.nc records number (',nn,') does no'//& 226 261 't match year length (',year_len,')' 227 262 IF(nn/=year_len) CALL abort_physic(modname,abort_message,1) 228 263 229 264 !--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH 230 ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid) 265 IF (grid_type==unstructured) THEN 266 ierr=NF90_INQ_DIMID(nid, 'cell', ndimid) 267 ELSE 268 ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid) 269 ENDIF 231 270 ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn) 232 271 WRITE(abort_message,'(a,2(i0,a))')'limit.nc horizontal number of cells (',nn, & … … 249 288 250 289 is_modified = .FALSE. 251 IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN ! time to read 290 !ym IF (MOD(itime-1, lmt_pas) == 0 .OR. jour_lu /= jour ) THEN ! time to read 291 ! not REALLY PERIODIC 292 IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read 293 ! IF (MOD(itime-1, lmt_pas) == 0) THEN ! time to read 252 294 jour_lu = jour 253 295 is_modified = .TRUE. 296 297 IF (grid_type==unstructured) THEN 298 299 #ifdef CPP_XIOS 300 IF ( type_ocean /= 'couple') THEN 301 302 IF (is_omp_master) CALL xios_recv_field("foce_limin",pct_mpi(:,is_oce)) 303 IF (is_omp_master) CALL xios_recv_field("fsic_limin",pct_mpi(:,is_sic)) 304 ! IF (read_continents .OR. itime == 1) THEN 305 IF (is_omp_master) CALL xios_recv_field("fter_limin",pct_mpi(:,is_ter)) 306 IF (is_omp_master) CALL xios_recv_field("flic_limin",pct_mpi(:,is_lic)) 307 ! ENDIF 308 ENDIF! type_ocean /= couple 309 310 IF ( type_ocean /= 'couple') THEN 311 IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi) 312 ENDIF 313 314 IF (.NOT. ok_veget) THEN 315 IF (is_omp_master) CALL xios_recv_field("alb_limin",alb_mpi) 316 IF (is_omp_master) CALL xios_recv_field("rug_limin",rug_mpi) 317 ENDIF 318 319 IF ( type_ocean /= 'couple') THEN 320 CALL Scatter_omp(sst_mpi,sst) 321 CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce)) 322 CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic)) 323 ! IF (read_continents .OR. itime == 1) THEN 324 CALL Scatter_omp(pct_mpi(:,is_ter),pctsrf(:,is_ter)) 325 CALL Scatter_omp(pct_mpi(:,is_lic),pctsrf(:,is_lic)) 326 ! END IF 327 END IF 328 329 IF (.NOT. ok_veget) THEN 330 CALL Scatter_omp(alb_mpi, albedo) 331 CALL Scatter_omp(rug_mpi, rugos) 332 END IF 333 #endif 334 335 336 ELSE ! grid_type==regular 337 254 338 !$OMP MASTER ! Only master thread 255 IF (is_mpi_root) THEN ! Only master processus 339 IF (is_mpi_root) THEN ! Only master processus! 256 340 257 341 ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid) … … 371 455 END IF 372 456 457 ENDIF ! Grid type 458 373 459 ENDIF ! time to read 374 460 -
LMDZ6/trunk/libf/phylmd/moy_undefSTD.F90
r2380 r3435 75 75 76 76 IF (n==1 .AND. itap==itapm1 .OR. n>1 .AND. mod(itap,nint(freq_outnmc(n)/ & 77 dtime))==0) THEN77 phys_tstep))==0) THEN 78 78 79 79 ! print*,'moy_undefSTD n itap itapm1',n,itap,itapm1 … … 140 140 END DO !i 141 141 END DO !k 142 END IF !MOD(itap,NINT(freq_outNMC(n)/ dtime)).EQ.0142 END IF !MOD(itap,NINT(freq_outNMC(n)/phys_tstep)).EQ.0 143 143 144 144 END DO !n -
LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90
r3402 r3435 59 59 USE print_control_mod, ONLY: lunout 60 60 USE ioipsl_getin_p_mod, ONLY : getin_p 61 IMPLICIT NONE 61 62 62 63 INCLUDE "dimsoil.h" … … 287 288 USE indice_sol_mod 288 289 USE time_phylmdz_mod, ONLY : day_ini,annee_ref,itau_phy 289 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 290 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dto2d_glo 290 291 USE print_control_mod, ONLY : prt_level,lunout 291 292 USE ioipsl_getin_p_mod, ONLY : getin_p … … 852 853 idayref = day_ini 853 854 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 854 CALL gr _fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon,zx_lon)855 CALL grid1dTo2d_glo(rlon,zx_lon) 855 856 DO i = 1, nbp_lon 856 857 zx_lon(i,1) = rlon(i+1) 857 858 zx_lon(i,nbp_lat) = rlon(i+1) 858 859 ENDDO 859 CALL gr _fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat,zx_lat)860 CALL grid1dTo2d_glo(rlat,zx_lat) 860 861 CALL histbeg("sous_index",nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:), & 861 862 1,nbp_lon,1,nbp_lat, & … … 1927 1928 itap, dtime, jour, knon, ni, & 1928 1929 !!jyg ypplay(:,1), zgeo1/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& 1929 ypplay(:,1), zgeo1 /RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt1, yq1,&1930 ypplay(:,1), zgeo1(1:knon)/RG, ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),& ! ym missing init 1930 1931 AcoefH, AcoefQ, BcoefH, BcoefQ, & 1931 1932 AcoefU, AcoefV, BcoefU, BcoefV, & -
LMDZ6/trunk/libf/phylmd/phyaqua_mod.F90
r3401 r3435 29 29 USE indice_sol_mod 30 30 USE nrtype, ONLY: pi 31 USE ioipsl 31 ! USE ioipsl 32 USE mod_phys_lmdz_para, ONLY: is_master 33 USE mod_phys_lmdz_transfert_para, ONLY: bcast 34 USE mod_grid_phy_lmdz 35 USE ioipsl_getin_p_mod, ONLY : getin_p 32 36 IMPLICIT NONE 33 37 … … 57 61 INTEGER it, unit, i, k, itap 58 62 59 REAL airefi, zcufi, zcvfi60 61 63 REAL rugos, albedo 62 64 REAL tsurf … … 64 66 REAL qsol_f 65 67 REAL rugsrel(nlon) 66 ! real zmea(nlon),zstd(nlon),zsig(nlon)67 ! real zgam(nlon),zthe(nlon),zpic(nlon),zval(nlon)68 ! real rlon(nlon),rlat(nlon)69 68 LOGICAL alb_ocean 70 ! integer demih_pas71 69 72 70 CHARACTER *80 ans, file_forctl, file_fordat, file_start … … 86 84 87 85 INTEGER, SAVE :: read_climoz = 0 ! read ozone climatology 88 89 ! intermediate variables to use getin (need to be "save" to be shared by 90 ! all threads) 91 INTEGER, SAVE :: nbapp_rad_omp 92 REAL, SAVE :: co2_ppm_omp, solaire_omp 93 LOGICAL, SAVE :: alb_ocean_omp 94 REAL, SAVE :: rugos_omp 86 !$OMP THREADPRIVATE(read_climoz) 87 95 88 ! ------------------------------------------------------------------------- 96 89 ! declaration pour l'appel a phyredem … … 117 110 INTEGER l, ierr, aslun 118 111 119 ! REAL longitude, latitude120 112 REAL paire 121 113 122 ! DATA latitude, longitude/48., 0./123 114 124 115 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 148 139 time = 0. 149 140 150 ! IM ajout latfi, lonfi151 ! rlatd = latfi152 ! rlond = lonfi153 ! rlat = rlatd*180./pi154 ! rlon = rlond*180./pi155 156 141 ! ----------------------------------------------------------------------- 157 142 ! initialisations de la physique … … 160 145 day_ini = day_ref 161 146 day_end = day_ini + ndays 162 ! airefi = 1. 163 ! zcufi = 1. 164 ! zcvfi = 1. 165 !$OMP MASTER 166 nbapp_rad_omp = 24 167 CALL getin('nbapp_rad', nbapp_rad_omp) 168 !$OMP END MASTER 169 !$OMP BARRIER 170 nbapp_rad = nbapp_rad_omp 147 148 nbapp_rad = 24 149 CALL getin_p('nbapp_rad', nbapp_rad) 171 150 172 151 ! --------------------------------------------------------------------- … … 175 154 ! Initialisations des constantes 176 155 ! Ajouter les manquants dans planete.def... (albedo etc) 177 !$OMP MASTER 178 co2_ppm_omp = 348. 179 CALL getin('co2_ppm', co2_ppm_omp) 180 solaire_omp = 1365. 181 CALL getin('solaire', solaire_omp) 156 co2_ppm = 348. 157 CALL getin_p('co2_ppm', co2_ppm) 158 159 solaire = 1365. 160 CALL getin_p('solaire', solaire) 161 182 162 ! CALL getin('albedo',albedo) ! albedo is set below, depending on 183 163 ! type_aqua 184 alb_ocean_omp = .TRUE. 185 CALL getin('alb_ocean', alb_ocean_omp) 186 !$OMP END MASTER 187 !$OMP BARRIER 188 co2_ppm = co2_ppm_omp 164 alb_ocean = .TRUE. 165 CALL getin_p('alb_ocean', alb_ocean) 166 189 167 WRITE (*, *) 'iniaqua: co2_ppm=', co2_ppm 190 solaire = solaire_omp191 168 WRITE (*, *) 'iniaqua: solaire=', solaire 192 alb_ocean = alb_ocean_omp193 169 WRITE (*, *) 'iniaqua: alb_ocean=', alb_ocean 194 170 … … 226 202 END IF 227 203 228 !$OMP MASTER 229 rugos_omp = rugos 230 CALL getin('rugos', rugos_omp) 231 !$OMP END MASTER 232 !$OMP BARRIER 233 rugos = rugos_omp 204 CALL getin_p('rugos', rugos) 205 234 206 WRITE (*, *) 'iniaqua: rugos=', rugos 235 207 zmasq(:) = pctsrf(:, is_ter) … … 262 234 CALL profil_sst(nlon, latitude, type_profil, phy_sst) 263 235 264 CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, & 265 phy_fter, phy_foce, phy_flic, phy_fsic) 266 236 IF (grid_type==unstructured) THEN 237 CALL writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, & 238 phy_fter, phy_foce, phy_flic, phy_fsic) 239 ELSE 240 241 CALL writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, phy_ice, & 242 phy_fter, phy_foce, phy_flic, phy_fsic) 243 ENDIF 267 244 268 245 ! --------------------------------------------------------------------- … … 339 316 PRINT *, 'iniaqua: before phyredem' 340 317 341 pbl_tke(:,:,:) =1.e-8318 pbl_tke(:,:,:) = 1.e-8 342 319 falb1 = albedo 343 320 falb2 = albedo … … 349 326 wake_deltaq = 0. 350 327 wake_s = 0. 351 wake_dens = 0. 328 wake_dens = 0. 352 329 wake_cstar = 0. 353 330 wake_pe = 0. … … 360 337 alp_bl =0. 361 338 treedrg(:,:,:)=0. 339 340 !ym error : the sub surface dimension is the third not second : forgotten for iniaqua 341 ! falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6 342 ! falb_dir(:,is_oce,:)=0.5; falb_dir(:,is_sic,:)=0.6 343 falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6 344 falb_dir(:,:,is_oce)=0.5; falb_dir(:,:,is_sic)=0.6 345 346 !ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ? 347 !ym probably the uninitialized value was 0 for standard (regular grid) case 348 falb_dif(:,:,:)=0 362 349 363 350 … … 488 475 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 489 476 490 SUBROUTINE writelim (klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, &477 SUBROUTINE writelim_unstruct(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, & 491 478 phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic) 492 479 493 USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root 494 USE mod_grid_phy_lmdz, ONLY: klon_glo 495 USE mod_phys_lmdz_transfert_para, ONLY: gather 480 USE mod_phys_lmdz_para, ONLY: is_omp_master, klon_mpi 481 USE mod_phys_lmdz_transfert_para, ONLY: gather_omp 482 #ifdef CPP_XIOS 483 USE xios 484 #endif 496 485 IMPLICIT NONE 486 497 487 include "netcdf.inc" 498 488 … … 509 499 REAL, INTENT (IN) :: phy_fsic(klon, 360) 510 500 501 REAL :: phy_mpi(klon_mpi, 360) ! temporary variable, to store phy_***(:) 502 ! on the whole physics grid 503 504 #ifdef CPP_XIOS 505 PRINT *, 'writelim: Ecriture du fichier limit' 506 507 CALL gather_omp(phy_foce, phy_mpi) 508 IF (is_omp_master) CALL xios_send_field('foce_limout',phy_mpi) 509 510 CALL gather_omp(phy_fsic, phy_mpi) 511 IF (is_omp_master) CALL xios_send_field('fsic_limout',phy_mpi) 512 513 CALL gather_omp(phy_fter, phy_mpi) 514 IF (is_omp_master) CALL xios_send_field('fter_limout',phy_mpi) 515 516 CALL gather_omp(phy_flic, phy_mpi) 517 IF (is_omp_master) CALL xios_send_field('flic_limout',phy_mpi) 518 519 CALL gather_omp(phy_sst, phy_mpi) 520 IF (is_omp_master) CALL xios_send_field('sst_limout',phy_mpi) 521 522 CALL gather_omp(phy_bil, phy_mpi) 523 IF (is_omp_master) CALL xios_send_field('bils_limout',phy_mpi) 524 525 CALL gather_omp(phy_alb, phy_mpi) 526 IF (is_omp_master) CALL xios_send_field('alb_limout',phy_mpi) 527 528 CALL gather_omp(phy_rug, phy_mpi) 529 IF (is_omp_master) CALL xios_send_field('rug_limout',phy_mpi) 530 #endif 531 END SUBROUTINE writelim_unstruct 532 533 534 535 SUBROUTINE writelim(klon, phy_nat, phy_alb, phy_sst, phy_bil, phy_rug, & 536 phy_ice, phy_fter, phy_foce, phy_flic, phy_fsic) 537 538 USE mod_phys_lmdz_para, ONLY: is_master 539 USE mod_grid_phy_lmdz, ONLY: klon_glo 540 USE mod_phys_lmdz_transfert_para, ONLY: gather 541 IMPLICIT NONE 542 include "netcdf.inc" 543 544 INTEGER, INTENT (IN) :: klon 545 REAL, INTENT (IN) :: phy_nat(klon, 360) 546 REAL, INTENT (IN) :: phy_alb(klon, 360) 547 REAL, INTENT (IN) :: phy_sst(klon, 360) 548 REAL, INTENT (IN) :: phy_bil(klon, 360) 549 REAL, INTENT (IN) :: phy_rug(klon, 360) 550 REAL, INTENT (IN) :: phy_ice(klon, 360) 551 REAL, INTENT (IN) :: phy_fter(klon, 360) 552 REAL, INTENT (IN) :: phy_foce(klon, 360) 553 REAL, INTENT (IN) :: phy_flic(klon, 360) 554 REAL, INTENT (IN) :: phy_fsic(klon, 360) 555 511 556 REAL :: phy_glo(klon_glo, 360) ! temporary variable, to store phy_***(:) 512 557 ! on the whole physics grid … … 522 567 INTEGER id_fter, id_foce, id_fsic, id_flic 523 568 524 IF (is_m pi_root .AND. is_omp_root) THEN569 IF (is_master) THEN 525 570 526 571 PRINT *, 'writelim: Ecriture du fichier limit' … … 627 672 END DO 628 673 629 END IF ! of if (is_m pi_root.and.is_omp_root)674 END IF ! of if (is_master) 630 675 631 676 ! write the fields, after having collected them on master 632 677 633 678 CALL gather(phy_nat, phy_glo) 634 IF (is_m pi_root .AND. is_omp_root) THEN679 IF (is_master) THEN 635 680 #ifdef NC_DOUBLE 636 681 ierr = nf_put_var_double(nid, id_nat, phy_glo) … … 645 690 646 691 CALL gather(phy_sst, phy_glo) 647 IF (is_m pi_root .AND. is_omp_root) THEN692 IF (is_master) THEN 648 693 #ifdef NC_DOUBLE 649 694 ierr = nf_put_var_double(nid, id_sst, phy_glo) … … 658 703 659 704 CALL gather(phy_bil, phy_glo) 660 IF (is_m pi_root .AND. is_omp_root) THEN705 IF (is_master) THEN 661 706 #ifdef NC_DOUBLE 662 707 ierr = nf_put_var_double(nid, id_bils, phy_glo) … … 671 716 672 717 CALL gather(phy_alb, phy_glo) 673 IF (is_m pi_root .AND. is_omp_root) THEN718 IF (is_master) THEN 674 719 #ifdef NC_DOUBLE 675 720 ierr = nf_put_var_double(nid, id_alb, phy_glo) … … 684 729 685 730 CALL gather(phy_rug, phy_glo) 686 IF (is_m pi_root .AND. is_omp_root) THEN731 IF (is_master) THEN 687 732 #ifdef NC_DOUBLE 688 733 ierr = nf_put_var_double(nid, id_rug, phy_glo) … … 697 742 698 743 CALL gather(phy_fter, phy_glo) 699 IF (is_m pi_root .AND. is_omp_root) THEN744 IF (is_master) THEN 700 745 #ifdef NC_DOUBLE 701 746 ierr = nf_put_var_double(nid, id_fter, phy_glo) … … 710 755 711 756 CALL gather(phy_foce, phy_glo) 712 IF (is_m pi_root .AND. is_omp_root) THEN757 IF (is_master) THEN 713 758 #ifdef NC_DOUBLE 714 759 ierr = nf_put_var_double(nid, id_foce, phy_glo) … … 723 768 724 769 CALL gather(phy_fsic, phy_glo) 725 IF (is_m pi_root .AND. is_omp_root) THEN770 IF (is_master) THEN 726 771 #ifdef NC_DOUBLE 727 772 ierr = nf_put_var_double(nid, id_fsic, phy_glo) … … 736 781 737 782 CALL gather(phy_flic, phy_glo) 738 IF (is_m pi_root .AND. is_omp_root) THEN783 IF (is_master) THEN 739 784 #ifdef NC_DOUBLE 740 785 ierr = nf_put_var_double(nid, id_flic, phy_glo) … … 749 794 750 795 ! close file: 751 IF (is_m pi_root .AND. is_omp_root) THEN796 IF (is_master) THEN 752 797 ierr = nf_close(nid) 753 798 END IF -
LMDZ6/trunk/libf/phylmd/phyetat0.F90
r3422 r3435 9 9 USE pbl_surface_mod, ONLY : pbl_surface_init 10 10 USE surface_data, ONLY : type_ocean, version_ocean 11 USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, dtime, &11 USE phys_state_var_mod, ONLY : ancien_ok, clwcon, detr_therm, phys_tstep, & 12 12 qsol, fevap, z0m, z0h, agesno, & 13 13 du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, & … … 472 472 473 473 IF ( type_ocean == 'slab' ) THEN 474 CALL ocean_slab_init( dtime, pctsrf)474 CALL ocean_slab_init(phys_tstep, pctsrf) 475 475 IF (nslay.EQ.1) THEN 476 476 found=phyetat0_get(1,tslab,"tslab01","tslab",0.) … … 521 521 ! Initialize module ocean_cpl_mod for the case of coupled ocean 522 522 IF ( type_ocean == 'couple' ) THEN 523 CALL ocean_cpl_init( dtime, longitude_deg, latitude_deg)524 ENDIF 525 526 CALL init_iophy_new(latitude_deg, longitude_deg)523 CALL ocean_cpl_init(phys_tstep, longitude_deg, latitude_deg) 524 ENDIF 525 526 ! CALL init_iophy_new(latitude_deg, longitude_deg) 527 527 528 528 ! Initilialize module fonte_neige_mod -
LMDZ6/trunk/libf/phylmd/phys_cal_mod.F90
r2802 r3435 1 ! $Id :$1 ! $Id$ 2 2 MODULE phys_cal_mod 3 3 ! This module contains information on the calendar at the current time step … … 37 37 SUBROUTINE phys_cal_init(annee_ref,day_ref) 38 38 39 USE IOIPSL, ONLY: ymds2ju 39 USE IOIPSL, ONLY: ymds2ju, ioconf_calendar 40 USE mod_phys_lmdz_para, ONLY: is_master,is_omp_master 40 41 USE ioipsl_getin_p_mod, ONLY: getin_p 41 42 … … 47 48 calend = 'earth_360d' ! default 48 49 CALL getin_p("calend",calend) 50 51 IF (is_omp_master) THEN 52 IF (calend == 'earth_360d') THEN 53 CALL ioconf_calendar('360d') 54 ELSE IF (calend == 'earth_365d') THEN 55 CALL ioconf_calendar('noleap') 56 ELSE IF (calend == 'earth_366d') THEN 57 CALL ioconf_calendar('gregorian') 58 ELSE 59 CALL abort_physic('phys_cal_init','Mauvais choix de calendrier',1) 60 ENDIF 61 ENDIF 62 !$OMP BARRIER 49 63 50 64 CALL ymds2ju(annee_ref, 1, day_ref, 0., jD_ref) -
LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90
r3379 r3435 343 343 !$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w) 344 344 !jyg< 345 !!! Entr \E9es suppl\E9mentaires couche-limite345 !!! Entrees supplementaires couche-limite 346 346 !! REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: t_x, t_w 347 347 !!!$OMP THREADPRIVATE(t_x, t_w) … … 349 349 !!!$OMP THREADPRIVATE(q_x, q_w) 350 350 !>jyg 351 ! Variables suppl\E9mentaires dans physiq.F relative au splitting de la surface 351 !!! Sorties ferret 352 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dtvdf_x, dtvdf_w 353 !$OMP THREADPRIVATE(dtvdf_x, dtvdf_w) 354 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dqvdf_x, dqvdf_w 355 !$OMP THREADPRIVATE(dqvdf_x, dqvdf_w) 356 ! Variables supplementaires dans physiq.F relative au splitting de la surface 352 357 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pbl_tke_input 353 358 !$OMP THREADPRIVATE(pbl_tke_input) … … 578 583 ALLOCATE(plul_st(klon),plul_th(klon)) 579 584 ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev)) 585 586 ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev)) 587 ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev)) 588 580 589 ALLOCATE(d_u_vdf(klon,klev),d_v_vdf(klon,klev)) 581 590 ALLOCATE(d_t_oli(klon,klev),d_t_oro(klon,klev)) … … 589 598 ! Special RRTM 590 599 ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1)) 600 ZFLDN0= 0. 591 601 ALLOCATE(ZFLUP0(klon,klev+1),ZFSDN0(klon,klev+1),ZFSUP0(klon,klev+1)) 592 602 ! … … 603 613 ALLOCATE(dv_gwd_rando(klon,klev),dv_gwd_front(klon,klev)) 604 614 ALLOCATE(east_gwstress(klon,klev),west_gwstress(klon,klev)) 615 east_gwstress(:,:)=0 !ym missing init 616 west_gwstress(:,:)=0 !ym missing init 605 617 ALLOCATE(d_t_hin(klon,klev)) 606 618 ALLOCATE(d_q_ch4(klon,klev)) … … 627 639 ALLOCATE(od865aer(klon)) 628 640 ALLOCATE(dryod550aer(klon)) 641 dryod550aer(:) = 0. 629 642 ALLOCATE(abs550aer(klon)) 643 abs550aer(:) = 0. 630 644 ALLOCATE(ec550aer(klon,klev)) 631 645 ALLOCATE(od550lt1aer(klon)) … … 672 686 ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon)) 673 687 674 ! FH Ajout de celles n ??cessaires au phys_output_write_mod688 ! FH Ajout de celles necessaires au phys_output_write_mod 675 689 676 690 ALLOCATE(tal1(klon), pal1(klon), pab1(klon), pab2(klon)) … … 721 735 !! ALLOCATE(q_x(klon,klev), q_w(klon,klev)) 722 736 !>jyg 723 ALLOCATE(d_t_vdf_x(klon,klev), d_t_vdf_w(klon,klev)) 724 ALLOCATE(d_q_vdf_x(klon,klev), d_q_vdf_w(klon,klev)) 737 ALLOCATE(dtvdf_x(klon,klev), dtvdf_w(klon,klev)) 738 dtvdf_x = 0 ; dtvdf_w=0 ; !ym missing init 739 ALLOCATE(dqvdf_x(klon,klev), dqvdf_w(klon,klev)) 740 dqvdf_x = 0 ; dqvdf_w=0 ; !ym missing init 725 741 ALLOCATE(pbl_tke_input(klon,klev+1,nbsrf)) 726 742 ALLOCATE(t_therm(klon,klev), q_therm(klon,klev),u_therm(klon,klev), v_therm(klon,klev)) … … 738 754 ALLOCATE(sens(klon), flwp(klon), fiwp(klon)) 739 755 ALLOCATE(alp_bl_conv(klon), alp_bl_det(klon)) 756 ale_bl_stat(:)=0 ; alp_bl_conv(:)=0 ; alp_bl_det(:)=0 740 757 ALLOCATE(alp_bl_fluct_m(klon), alp_bl_fluct_tke(klon)) 758 alp_bl_fluct_m(:)=0 ; alp_bl_fluct_tke(:)= 0. 741 759 ALLOCATE(alp_bl_stat(klon), n2(klon), s2(klon)) 760 alp_bl_stat(:)=0 742 761 ALLOCATE(proba_notrig(klon), random_notrig(klon)) 743 762 ALLOCATE(cv_gen(klon)) … … 968 987 DEALLOCATE(toplwad0_aerop, sollwad0_aerop) 969 988 970 ! FH Ajout de celles n ??cessaires au phys_output_write_mod989 ! FH Ajout de celles necessaires au phys_output_write_mod 971 990 DEALLOCATE(tal1, pal1, pab1, pab2) 972 991 DEALLOCATE(ptstar, pt0, slp) -
LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90
r3381 r3435 367 367 ! ug Pour les sorties XIOS 368 368 USE xios 369 USE wxios, ONLY: wxios_closedef, missing_val 369 USE wxios, ONLY: wxios_closedef, missing_val, wxios_set_context 370 370 #endif 371 371 USE phys_cal_mod, ONLY : mth_len … … 437 437 CALL set_itau_iophy(itau_w) 438 438 439 IF (.NOT.vars_defined) THEN 440 iinitend = 2 441 ELSE 439 ! IF (.NOT.vars_defined) THEN 442 440 iinitend = 1 443 ENDIF 441 ! ELSE 442 ! iinitend = 1 443 ! ENDIF 444 445 #ifdef CPP_XIOS 446 CALL wxios_set_context 447 #endif 444 448 445 449 DO ilev=1,klev … … 712 716 CALL histwrite_phy(o_fsnow, zfra_o) 713 717 CALL histwrite_phy(o_evap, evap) 714 CALL histwrite_phy(o_tops, topsw*swradcorr) 715 CALL histwrite_phy(o_tops0, topsw0*swradcorr) 718 719 IF (vars_defined) THEN 720 zx_tmp_fi2d = topsw*swradcorr 721 ENDIF 722 CALL histwrite_phy(o_tops, zx_tmp_fi2d) 723 724 IF (vars_defined) THEN 725 zx_tmp_fi2d = topsw0*swradcorr 726 ENDIF 727 CALL histwrite_phy(o_tops0, zx_tmp_fi2d) 728 716 729 CALL histwrite_phy(o_topl, toplw) 717 730 CALL histwrite_phy(o_topl0, toplw0) … … 746 759 ENDIF 747 760 CALL histwrite_phy(o_nettop, zx_tmp_fi2d) 748 CALL histwrite_phy(o_SWup200, SWup200*swradcorr) 749 CALL histwrite_phy(o_SWup200clr, SWup200clr*swradcorr) 750 CALL histwrite_phy(o_SWdn200, SWdn200*swradcorr) 751 CALL histwrite_phy(o_SWdn200clr, SWdn200clr*swradcorr) 761 762 IF (vars_defined) THEN 763 zx_tmp_fi2d = SWup200*swradcorr 764 ENDIF 765 CALL histwrite_phy(o_SWup200, zx_tmp_fi2d) 766 767 IF (vars_defined) THEN 768 zx_tmp_fi2d = SWup200clr*swradcorr 769 ENDIF 770 CALL histwrite_phy(o_SWup200clr, zx_tmp_fi2d) 771 772 IF (vars_defined) THEN 773 zx_tmp_fi2d = SWdn200*swradcorr 774 ENDIF 775 CALL histwrite_phy(o_SWdn200, zx_tmp_fi2d) 776 777 778 IF (vars_defined) THEN 779 zx_tmp_fi2d = SWdn200clr*swradcorr 780 ENDIF 781 CALL histwrite_phy(o_SWdn200clr, zx_tmp_fi2d) 782 752 783 CALL histwrite_phy(o_LWup200, LWup200) 753 784 CALL histwrite_phy(o_LWup200clr, LWup200clr) 754 785 CALL histwrite_phy(o_LWdn200, LWdn200) 755 786 CALL histwrite_phy(o_LWdn200clr, LWdn200clr) 756 CALL histwrite_phy(o_sols, solsw*swradcorr) 757 CALL histwrite_phy(o_sols0, solsw0*swradcorr) 787 788 IF (vars_defined) THEN 789 zx_tmp_fi2d = solsw*swradcorr 790 ENDIF 791 CALL histwrite_phy(o_sols, zx_tmp_fi2d) 792 793 794 IF (vars_defined) THEN 795 zx_tmp_fi2d = solsw0*swradcorr 796 ENDIF 797 CALL histwrite_phy(o_sols0, zx_tmp_fi2d) 758 798 CALL histwrite_phy(o_soll, sollw) 759 799 CALL histwrite_phy(o_soll0, sollw0) … … 950 990 CALL histwrite_phy(o_cldt, cldt) 951 991 CALL histwrite_phy(o_JrNt, JrNt) 952 CALL histwrite_phy(o_cldljn, cldl*JrNt) 953 CALL histwrite_phy(o_cldmjn, cldm*JrNt) 954 CALL histwrite_phy(o_cldhjn, cldh*JrNt) 955 CALL histwrite_phy(o_cldtjn, cldt*JrNt) 992 993 IF (vars_defined) zx_tmp_fi2d=cldl*JrNt 994 CALL histwrite_phy(o_cldljn, zx_tmp_fi2d) 995 996 IF (vars_defined) zx_tmp_fi2d=cldm*JrNt 997 CALL histwrite_phy(o_cldmjn, zx_tmp_fi2d) 998 999 IF (vars_defined) zx_tmp_fi2d=cldh*JrNt 1000 CALL histwrite_phy(o_cldhjn, zx_tmp_fi2d) 1001 1002 IF (vars_defined) zx_tmp_fi2d=cldt*JrNt 1003 CALL histwrite_phy(o_cldtjn, zx_tmp_fi2d) 1004 956 1005 CALL histwrite_phy(o_cldq, cldq) 957 1006 IF (vars_defined) zx_tmp_fi2d(1:klon) = flwp(1:klon) … … 1154 1203 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys 1155 1204 CALL histwrite_phy(o_dqwak, zx_tmp_fi3d) 1156 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1205 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1157 1206 CALL histwrite_phy(o_dqwak2d, zx_tmp_fi2d) 1158 1207 ENDIF ! iflag_wake>=1 … … 1318 1367 1319 1368 ! ThL -- In the following, we assume read_climoz == 1 1320 zx_tmp_fi2d = 0.0 ! Computation for strato, added ThL 1321 DO k=1, klev 1322 zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * stratomask(:,k) * 1.e3 1323 END DO 1369 IF (vars_defined) THEN 1370 zx_tmp_fi2d = 0.0 ! Computation for strato, added ThL 1371 DO k=1, klev 1372 zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * stratomask(:,k) * 1.e3 1373 END DO 1374 ENDIF 1324 1375 CALL histwrite_phy(o_col_O3_strato, zx_tmp_fi2d) ! Added ThL 1325 zx_tmp_fi2d = 0.0 ! Computation for tropo, added ThL 1326 DO k=1, klev 1327 zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * (1.0-stratomask(:,k)) * 1.e3 1328 END DO 1376 1377 IF (vars_defined) THEN 1378 zx_tmp_fi2d = 0.0 ! Computation for tropo, added ThL 1379 DO k=1, klev 1380 zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + wo(:,k,1) * (1.0-stratomask(:,k)) * 1.e3 1381 END DO 1382 ENDIF 1329 1383 CALL histwrite_phy(o_col_O3_tropo, zx_tmp_fi2d) ! Added ThL 1330 1384 ! end add ThL … … 1367 1421 #endif 1368 1422 IF (ok_ade) THEN 1369 CALL histwrite_phy(o_topswad, topswad_aero*swradcorr) 1370 CALL histwrite_phy(o_topswad0, topswad0_aero*swradcorr) 1371 CALL histwrite_phy(o_solswad, solswad_aero*swradcorr) 1372 CALL histwrite_phy(o_solswad0, solswad0_aero*swradcorr) 1423 IF (vars_defined) zx_tmp_fi2d(:)=topswad_aero*swradcorr 1424 CALL histwrite_phy(o_topswad, zx_tmp_fi2d) 1425 1426 IF (vars_defined) zx_tmp_fi2d(:)=topswad0_aero*swradcorr 1427 CALL histwrite_phy(o_topswad0, zx_tmp_fi2d) 1428 1429 IF (vars_defined) zx_tmp_fi2d(:)=solswad_aero*swradcorr 1430 CALL histwrite_phy(o_solswad, zx_tmp_fi2d) 1431 1432 IF (vars_defined) zx_tmp_fi2d(:)=solswad0_aero*swradcorr 1433 CALL histwrite_phy(o_solswad0, zx_tmp_fi2d) 1434 1373 1435 CALL histwrite_phy(o_toplwad, toplwad_aero) 1374 1436 CALL histwrite_phy(o_toplwad0, toplwad0_aero) … … 1377 1439 !====MS forcing diagnostics 1378 1440 IF (new_aod) THEN 1379 zx_tmp_fi2d(:)=topsw_aero(:,1)*swradcorr(:) 1441 !ym warning : topsw_aero, solsw_aero, topsw0_aero, solsw0_aero are not defined by model 1442 !ym => init to 0 in radlwsw_m.F90 ztopsw_aero, zsolsw_aero, ztopsw0_aero, zsolsw0_aero 1443 1444 IF (vars_defined) zx_tmp_fi2d(:)=topsw_aero(:,1)*swradcorr(:) 1380 1445 CALL histwrite_phy(o_swtoaas_nat,zx_tmp_fi2d) 1381 zx_tmp_fi2d(:)=solsw_aero(:,1)*swradcorr(:)1446 IF (vars_defined) zx_tmp_fi2d(:)=solsw_aero(:,1)*swradcorr(:) 1382 1447 CALL histwrite_phy(o_swsrfas_nat,zx_tmp_fi2d) 1383 zx_tmp_fi2d(:)=topsw0_aero(:,1)*swradcorr(:)1448 IF (vars_defined) zx_tmp_fi2d(:)=topsw0_aero(:,1)*swradcorr(:) 1384 1449 CALL histwrite_phy(o_swtoacs_nat,zx_tmp_fi2d) 1385 zx_tmp_fi2d(:)=solsw0_aero(:,1)*swradcorr(:)1450 IF (vars_defined) zx_tmp_fi2d(:)=solsw0_aero(:,1)*swradcorr(:) 1386 1451 CALL histwrite_phy(o_swsrfcs_nat,zx_tmp_fi2d) 1387 1452 !ant 1388 zx_tmp_fi2d(:)=topsw_aero(:,2)*swradcorr(:)1453 IF (vars_defined) zx_tmp_fi2d(:)=topsw_aero(:,2)*swradcorr(:) 1389 1454 CALL histwrite_phy(o_swtoaas_ant,zx_tmp_fi2d) 1390 zx_tmp_fi2d(:)=solsw_aero(:,2)*swradcorr(:)1455 IF (vars_defined) zx_tmp_fi2d(:)=solsw_aero(:,2)*swradcorr(:) 1391 1456 CALL histwrite_phy(o_swsrfas_ant,zx_tmp_fi2d) 1392 zx_tmp_fi2d(:)=topsw0_aero(:,2)*swradcorr(:)1457 IF (vars_defined) zx_tmp_fi2d(:)=topsw0_aero(:,2)*swradcorr(:) 1393 1458 CALL histwrite_phy(o_swtoacs_ant,zx_tmp_fi2d) 1394 zx_tmp_fi2d(:)=solsw0_aero(:,2)*swradcorr(:)1459 IF (vars_defined) zx_tmp_fi2d(:)=solsw0_aero(:,2)*swradcorr(:) 1395 1460 CALL histwrite_phy(o_swsrfcs_ant,zx_tmp_fi2d) 1396 1461 !cf 1397 1462 IF (.not. aerosol_couple) THEN 1398 zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:)1463 IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:) 1399 1464 CALL histwrite_phy(o_swtoacf_nat,zx_tmp_fi2d) 1400 zx_tmp_fi2d(:)=solswcf_aero(:,1)*swradcorr(:)1465 IF (vars_defined) zx_tmp_fi2d(:)=solswcf_aero(:,1)*swradcorr(:) 1401 1466 CALL histwrite_phy(o_swsrfcf_nat,zx_tmp_fi2d) 1402 zx_tmp_fi2d(:)=topswcf_aero(:,2)*swradcorr(:)1467 IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,2)*swradcorr(:) 1403 1468 CALL histwrite_phy(o_swtoacf_ant,zx_tmp_fi2d) 1404 zx_tmp_fi2d(:)=solswcf_aero(:,2)*swradcorr(:)1469 IF (vars_defined) zx_tmp_fi2d(:)=solswcf_aero(:,2)*swradcorr(:) 1405 1470 CALL histwrite_phy(o_swsrfcf_ant,zx_tmp_fi2d) 1406 zx_tmp_fi2d(:)=topswcf_aero(:,3)*swradcorr(:)1471 IF (vars_defined) zx_tmp_fi2d(:)=topswcf_aero(:,3)*swradcorr(:) 1407 1472 CALL histwrite_phy(o_swtoacf_zero,zx_tmp_fi2d) 1408 zx_tmp_fi2d(:)=solswcf_aero(:,3)*swradcorr(:)1473 IF (vars_defined) zx_tmp_fi2d(:)=solswcf_aero(:,3)*swradcorr(:) 1409 1474 CALL histwrite_phy(o_swsrfcf_zero,zx_tmp_fi2d) 1410 1475 ENDIF … … 1413 1478 ENDIF 1414 1479 IF (ok_aie) THEN 1415 CALL histwrite_phy(o_topswai, topswai_aero*swradcorr) 1416 CALL histwrite_phy(o_toplwai, toplwai_aero*swradcorr) 1417 CALL histwrite_phy(o_solswai, solswai_aero*swradcorr) 1418 CALL histwrite_phy(o_sollwai, sollwai_aero*swradcorr) 1480 IF (vars_defined) zx_tmp_fi2d(:)= topswai_aero*swradcorr 1481 CALL histwrite_phy(o_topswai, zx_tmp_fi2d) 1482 1483 IF (vars_defined) zx_tmp_fi2d(:)=toplwai_aero*swradcorr 1484 CALL histwrite_phy(o_toplwai, zx_tmp_fi2d) 1485 1486 IF (vars_defined) zx_tmp_fi2d(:)=solswai_aero*swradcorr 1487 CALL histwrite_phy(o_solswai, zx_tmp_fi2d) 1488 1489 IF (vars_defined) zx_tmp_fi2d(:)=sollwai_aero*swradcorr 1490 CALL histwrite_phy(o_sollwai, zx_tmp_fi2d) 1419 1491 ENDIF 1420 1492 IF (flag_aerosol.GT.0.AND.ok_cdnc) THEN … … 1446 1518 CALL histwrite_phy(o_ovap, q_seri) 1447 1519 CALL histwrite_phy(o_oliq, ql_seri) 1448 CALL histwrite_phy(o_ocond, ql_seri+qs_seri) 1520 1521 IF (vars_defined) zx_tmp_fi3d = ql_seri+qs_seri 1522 CALL histwrite_phy(o_ocond, zx_tmp_fi3d) 1523 1449 1524 CALL histwrite_phy(o_geop, zphi) 1450 1525 CALL histwrite_phy(o_vitu, u_seri) … … 1453 1528 CALL histwrite_phy(o_pres, pplay) 1454 1529 CALL histwrite_phy(o_paprs, paprs(:,1:klev)) 1455 CALL histwrite_phy(o_zfull,zphi/RG) 1530 1531 IF (vars_defined) zx_tmp_fi3d = zphi/RG 1532 CALL histwrite_phy(o_zfull,zx_tmp_fi3d) 1456 1533 1457 1534 #ifdef CPP_XIOS … … 1498 1575 CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d) 1499 1576 CALL histwrite_phy(o_rhum, zx_rh) 1500 CALL histwrite_phy(o_ozone, & 1501 wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd) 1577 1578 IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd 1579 CALL histwrite_phy(o_ozone, zx_tmp_fi3d) 1502 1580 1503 1581 IF (read_climoz == 2) THEN 1504 CALL histwrite_phy(o_ozone_light, &1505 wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd)1582 IF (vars_defined) zx_tmp_fi3d = wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd 1583 CALL histwrite_phy(o_ozone_light, zx_tmp_fi3d) 1506 1584 ENDIF 1507 1585 … … 1511 1589 1512 1590 CALL histwrite_phy(o_dqphy, d_qx(:,:,ivap)) 1513 CALL water_int(klon,klev,d_qx(:,:,ivap),zmasse,zx_tmp_fi2d)1591 IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,ivap),zmasse,zx_tmp_fi2d) 1514 1592 CALL histwrite_phy(o_dqphy2d, zx_tmp_fi2d) 1515 1593 1516 1594 CALL histwrite_phy(o_dqlphy, d_qx(:,:,iliq)) 1517 CALL water_int(klon,klev,d_qx(:,:,iliq),zmasse,zx_tmp_fi2d)1595 IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,iliq),zmasse,zx_tmp_fi2d) 1518 1596 CALL histwrite_phy(o_dqlphy2d, zx_tmp_fi2d) 1519 1597 1520 1598 IF (nqo.EQ.3) THEN 1521 1599 CALL histwrite_phy(o_dqsphy, d_qx(:,:,isol)) 1522 CALL water_int(klon,klev,d_qx(:,:,isol),zmasse,zx_tmp_fi2d)1600 IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,isol),zmasse,zx_tmp_fi2d) 1523 1601 CALL histwrite_phy(o_dqsphy2d, zx_tmp_fi2d) 1524 1602 ELSE … … 1605 1683 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys 1606 1684 CALL histwrite_phy(o_dqcon, zx_tmp_fi3d) 1607 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1685 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1608 1686 CALL histwrite_phy(o_dqcon2d, zx_tmp_fi2d) 1609 1687 … … 1627 1705 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys 1628 1706 CALL histwrite_phy(o_dqlsc, zx_tmp_fi3d) 1629 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1707 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1630 1708 CALL histwrite_phy(o_dqlsc2d, zx_tmp_fi2d) 1631 1709 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=beta_prec(1:klon,1:klev) … … 1640 1718 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys 1641 1719 CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d) 1642 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1720 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1643 1721 CALL histwrite_phy(o_dqlscth2d, zx_tmp_fi2d) 1644 1722 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys 1645 1723 CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d) 1646 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1724 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1647 1725 CALL histwrite_phy(o_dqlscst2d, zx_tmp_fi2d) 1648 1726 CALL histwrite_phy(o_plulth, plul_th) … … 1698 1776 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys 1699 1777 CALL histwrite_phy(o_dqvdf, zx_tmp_fi3d) 1700 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1778 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1701 1779 CALL histwrite_phy(o_dqvdf2d, zx_tmp_fi2d) 1702 1780 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys … … 1704 1782 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_eva(1:klon,1:klev)/pdtphys 1705 1783 CALL histwrite_phy(o_dqeva, zx_tmp_fi3d) 1706 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1784 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1707 1785 CALL histwrite_phy(o_dqeva2d, zx_tmp_fi2d) 1708 1786 CALL histwrite_phy(o_ratqs, ratqs) … … 1743 1821 ENDIF 1744 1822 CALL histwrite_phy(o_dqthe, zx_tmp_fi3d) 1745 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1823 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1746 1824 CALL histwrite_phy(o_dqthe2d, zx_tmp_fi2d) 1747 1825 ENDIF !iflag_thermals … … 1750 1828 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys 1751 1829 CALL histwrite_phy(o_dqajs, zx_tmp_fi3d) 1752 CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)1830 IF (vars_defined) CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d) 1753 1831 CALL histwrite_phy(o_dqajs2d, zx_tmp_fi2d) 1754 1832 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys … … 1786 1864 1787 1865 IF (ok_hines) THEN 1788 CALL histwrite_phy(o_du_gwd_hines, du_gwd_hines/pdtphys) 1789 CALL histwrite_phy(o_dv_gwd_hines, dv_gwd_hines/pdtphys) 1866 IF (vars_defined) zx_tmp_fi3d=du_gwd_hines/pdtphys 1867 CALL histwrite_phy(o_du_gwd_hines, zx_tmp_fi3d) 1868 1869 IF (vars_defined) zx_tmp_fi3d= dv_gwd_hines/pdtphys 1870 CALL histwrite_phy(o_dv_gwd_hines, zx_tmp_fi3d) 1871 1790 1872 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys 1791 1873 CALL histwrite_phy(o_dthin, zx_tmp_fi3d) … … 1795 1877 1796 1878 IF (.not. ok_hines .and. ok_gwd_rando) THEN 1797 CALL histwrite_phy(o_du_gwd_front, du_gwd_front / pdtphys) 1798 CALL histwrite_phy(o_dv_gwd_front, dv_gwd_front / pdtphys) 1879 IF (vars_defined) zx_tmp_fi3d=du_gwd_front / pdtphys 1880 CALL histwrite_phy(o_du_gwd_front, zx_tmp_fi3d) 1881 1882 IF (vars_defined) zx_tmp_fi3d=dv_gwd_front / pdtphys 1883 CALL histwrite_phy(o_dv_gwd_front, zx_tmp_fi3d) 1884 1799 1885 CALL histwrite_phy(o_ustr_gwd_front, zustr_gwd_front) 1800 1886 CALL histwrite_phy(o_vstr_gwd_front, zvstr_gwd_front) … … 1802 1888 1803 1889 IF (ok_gwd_rando) THEN 1804 CALL histwrite_phy(o_du_gwd_rando, du_gwd_rando / pdtphys) 1805 CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_rando / pdtphys) 1890 IF (vars_defined) zx_tmp_fi3d=du_gwd_rando / pdtphys 1891 CALL histwrite_phy(o_du_gwd_rando, zx_tmp_fi3d) 1892 1893 IF (vars_defined) zx_tmp_fi3d=dv_gwd_rando / pdtphys 1894 CALL histwrite_phy(o_dv_gwd_rando, zx_tmp_fi3d) 1806 1895 CALL histwrite_phy(o_ustr_gwd_rando, zustr_gwd_rando) 1807 1896 CALL histwrite_phy(o_vstr_gwd_rando, zvstr_gwd_rando) … … 1811 1900 1812 1901 IF (ok_qch4) THEN 1813 CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys) 1814 ENDIF 1815 1816 DO k=1, klevp1 1817 zx_tmp_fi3d1(:,k)=swup(:,k)*swradcorr(:) 1818 ENDDO 1902 IF (vars_defined) zx_tmp_fi3d=d_q_ch4 / pdtphys 1903 CALL histwrite_phy(o_dqch4, zx_tmp_fi3d) 1904 ENDIF 1905 1906 IF (vars_defined) THEN 1907 DO k=1, klevp1 1908 zx_tmp_fi3d1(:,k)=swup(:,k)*swradcorr(:) 1909 ENDDO 1910 ENDIF 1911 1819 1912 CALL histwrite_phy(o_rsu, zx_tmp_fi3d1) 1820 DO k=1, klevp1 1821 zx_tmp_fi3d1(:,k)=swdn(:,k)*swradcorr(:) 1822 ENDDO 1913 1914 1915 IF (vars_defined) THEN 1916 DO k=1, klevp1 1917 zx_tmp_fi3d1(:,k)=swdn(:,k)*swradcorr(:) 1918 ENDDO 1919 ENDIF 1920 1823 1921 CALL histwrite_phy(o_rsd, zx_tmp_fi3d1) 1824 DO k=1, klevp1 1825 zx_tmp_fi3d1(:,k)=swup0(:,k)*swradcorr(:) 1826 ENDDO 1922 1923 IF (vars_defined) THEN 1924 DO k=1, klevp1 1925 zx_tmp_fi3d1(:,k)=swup0(:,k)*swradcorr(:) 1926 ENDDO 1927 ENDIF 1928 1827 1929 CALL histwrite_phy(o_rsucs, zx_tmp_fi3d1) 1828 DO k=1, klevp1 1829 zx_tmp_fi3d1(:,k)=swupc0(:,k)*swradcorr(:) 1830 ENDDO 1930 1931 IF (vars_defined) THEN 1932 DO k=1, klevp1 1933 zx_tmp_fi3d1(:,k)=swupc0(:,k)*swradcorr(:) 1934 ENDDO 1935 ENDIF 1831 1936 CALL histwrite_phy(o_rsucsaf, zx_tmp_fi3d1) 1832 DO k=1, klevp1 1833 zx_tmp_fi3d1(:,k)=swdn0(:,k)*swradcorr(:) 1834 ENDDO 1937 1938 IF (vars_defined) THEN 1939 DO k=1, klevp1 1940 zx_tmp_fi3d1(:,k)=swdn0(:,k)*swradcorr(:) 1941 ENDDO 1942 ENDIF 1835 1943 CALL histwrite_phy(o_rsdcs, zx_tmp_fi3d1) 1836 DO k=1, klevp1 1837 zx_tmp_fi3d1(:,k)=swdnc0(:,k)*swradcorr(:) 1838 ENDDO 1944 1945 1946 IF (vars_defined) THEN 1947 DO k=1, klevp1 1948 zx_tmp_fi3d1(:,k)=swdnc0(:,k)*swradcorr(:) 1949 ENDDO 1950 ENDIF 1839 1951 CALL histwrite_phy(o_rsdcsaf, zx_tmp_fi3d1) 1840 1952 … … 1890 2002 ELSE IF (iflag_con == 2) THEN 1891 2003 CALL histwrite_phy(o_mcd, pmfd) 1892 CALL histwrite_phy(o_dmc, pmfu + pmfd) 2004 IF (vars_defined) zx_tmp_fi3d = pmfu + pmfd 2005 CALL histwrite_phy(o_dmc, zx_tmp_fi3d) 1893 2006 ENDIF 1894 2007 CALL histwrite_phy(o_ref_liq, ref_liq) … … 1904 2017 IF (vars_defined) zx_tmp_fi2d(:) = lwup0p(:,klevp1) 1905 2018 CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d) 1906 DO k=1, klevp1 1907 zx_tmp_fi3d1(:,k)=swupp(:,k)*swradcorr(:) 1908 ENDDO 2019 IF (vars_defined) THEN 2020 DO k=1, klevp1 2021 zx_tmp_fi3d1(:,k)=swupp(:,k)*swradcorr(:) 2022 ENDDO 2023 ENDIF 1909 2024 CALL histwrite_phy(o_rsu4co2, zx_tmp_fi3d1) 1910 DO k=1, klevp1 1911 zx_tmp_fi3d1(:,k)=swup0p(:,k)*swradcorr(:) 1912 ENDDO 2025 IF (vars_defined) THEN 2026 DO k=1, klevp1 2027 zx_tmp_fi3d1(:,k)=swup0p(:,k)*swradcorr(:) 2028 ENDDO 2029 ENDIF 1913 2030 CALL histwrite_phy(o_rsucs4co2, zx_tmp_fi3d1) 1914 DO k=1, klevp1 1915 zx_tmp_fi3d1(:,k)=swdnp(:,k)*swradcorr(:) 1916 ENDDO 2031 IF (vars_defined) THEN 2032 DO k=1, klevp1 2033 zx_tmp_fi3d1(:,k)=swdnp(:,k)*swradcorr(:) 2034 ENDDO 2035 ENDIF 1917 2036 CALL histwrite_phy(o_rsd4co2, zx_tmp_fi3d1) 1918 DO k=1, klevp1 1919 zx_tmp_fi3d1(:,k)=swdn0p(:,k)*swradcorr(:) 1920 ENDDO 2037 IF (vars_defined) THEN 2038 DO k=1, klevp1 2039 zx_tmp_fi3d1(:,k)=swdn0p(:,k)*swradcorr(:) 2040 ENDDO 2041 ENDIF 1921 2042 CALL histwrite_phy(o_rsdcs4co2, zx_tmp_fi3d1) 1922 2043 CALL histwrite_phy(o_rlu4co2, lwupp) … … 2071 2192 IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN 2072 2193 !--3D fields 2073 CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))2074 CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))2075 CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))2076 CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))2077 CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo))2078 CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo))2079 CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo))2080 CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo))2081 CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo))2082 CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo))2083 CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo))2084 CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo))2085 CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))2086 CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))2194 ! CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo)) 2195 ! CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo)) 2196 ! CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo)) 2197 ! CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo)) 2198 ! CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo)) 2199 ! CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo)) 2200 ! CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo)) 2201 ! CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo)) 2202 ! CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo)) 2203 ! CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo)) 2204 ! CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo)) 2205 ! CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo)) 2206 ! CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo)) 2207 ! CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo)) 2087 2208 !--2D fields 2088 CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo))2209 ! CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo)) 2089 2210 zx_tmp_fi2d=0. 2090 2211 IF (vars_defined) THEN -
LMDZ6/trunk/libf/phylmd/phys_state_var_mod.F90
r3208 r3435 18 18 INTEGER, SAVE :: radpas ! radiation is called every "radpas" step 19 19 INTEGER, SAVE :: cvpas ! convection is called every "cvpas" step 20 INTEGER, SAVE :: cvpas_0 ! reference value for cvpas20 INTEGER, SAVE :: cvpas_0 = 1 ! reference value for cvpas 21 21 INTEGER, SAVE :: wkpas ! wake scheme is called every "wkpas" step 22 22 REAL, PARAMETER :: missing_val_nf90=nf90_fill_real … … 25 25 !$OMP THREADPRIVATE(cvpas_0) 26 26 !$OMP THREADPRIVATE(wkpas) 27 REAL, SAVE :: dtime, solaire_etat028 !$OMP THREADPRIVATE( dtime, solaire_etat0)27 REAL, SAVE :: phys_tstep=0, solaire_etat0 28 !$OMP THREADPRIVATE(phys_tstep, solaire_etat0) 29 29 30 30 REAL, ALLOCATABLE, SAVE :: pctsrf(:,:) … … 286 286 REAL,ALLOCATABLE,SAVE :: total_rain(:), nday_rain(:) 287 287 !$OMP THREADPRIVATE(total_rain,nday_rain) 288 REAL,ALLOCATABLE,SAVE :: paire_ter(:) 289 !$OMP THREADPRIVATE(paire_ter) 288 290 ! albsol1: albedo du sol total pour SW visible 289 291 ! albsol2: albedo du sol total pour SW proche IR … … 417 419 ! tendencies on wind due to gravity waves 418 420 421 LOGICAL,SAVE :: is_initialized=.FALSE. 422 !$OMP THREADPRIVATE(is_initialized) 423 419 424 CONTAINS 420 425 … … 437 442 include "clesphys.h" 438 443 444 IF (is_initialized) RETURN 445 is_initialized=.TRUE. 439 446 ALLOCATE(pctsrf(klon,nbsrf)) 440 447 ALLOCATE(ftsol(klon,nbsrf)) … … 452 459 ALLOCATE(snow_fall(klon)) 453 460 ALLOCATE(solsw(klon), sollw(klon)) 461 sollw=0.0 454 462 ALLOCATE(radsol(klon)) 455 463 ALLOCATE(swradcorr(klon)) … … 541 549 ALLOCATE(wake_deltat(klon,klev), wake_deltaq(klon,klev)) 542 550 ALLOCATE(wake_s(klon), awake_dens(klon), wake_dens(klon)) 551 awake_dens = 0. 543 552 ALLOCATE(wake_Cstar(klon)) 544 553 ALLOCATE(wake_pe(klon), wake_fip(klon)) … … 549 558 ALLOCATE(pfrac_1nucl(klon,klev)) 550 559 ALLOCATE(total_rain(klon), nday_rain(klon)) 560 ALLOCATE(paire_ter(klon)) 551 561 ALLOCATE(albsol1(klon), albsol2(klon)) 552 562 !albedo SB >>> … … 566 576 ALLOCATE(topsw(klon), toplw(klon)) 567 577 ALLOCATE(sollwdown(klon), sollwdownclr(klon)) 578 sollwdown = 0. 568 579 ALLOCATE(toplwdown(klon), toplwdownclr(klon)) 569 580 ALLOCATE(topsw0(klon),toplw0(klon),solsw0(klon),sollw0(klon)) 581 sollw0 = 0. 570 582 ALLOCATE(albpla(klon)) 571 583 !IM ajout variables CFMIP2/CMIP5 … … 604 616 ALLOCATE(ale_bl_trig(klon)) 605 617 !!! fin nrlmd le 10/04/2012 606 if (ok_gwd_rando) allocate(du_gwd_rando(klon, klev)) 607 if (.not. ok_hines .and. ok_gwd_rando) allocate(du_gwd_front(klon, klev)) 608 618 IF (ok_gwd_rando) THEN 619 allocate(du_gwd_rando(klon, klev)) 620 du_gwd_rando(:,:)=0. 621 ENDIF 622 IF (.not. ok_hines .and. ok_gwd_rando) THEN 623 ALLOCATE(du_gwd_front(klon, klev)) 624 du_gwd_front(:,:) = 0 !ym missing init 625 ENDIF 609 626 END SUBROUTINE phys_state_var_init 610 627 … … 691 708 deallocate(pfrac_1nucl) 692 709 deallocate(total_rain, nday_rain) 710 deallocate(paire_ter) 693 711 deallocate(albsol1, albsol2) 694 712 !albedo SB >>> … … 738 756 deallocate(ale_bl_trig) 739 757 !!! fin nrlmd le 10/04/2012 740 758 is_initialized=.FALSE. 741 759 END SUBROUTINE phys_state_var_end 742 760 -
LMDZ6/trunk/libf/phylmd/physiq_mod.F90
r3418 r3435 25 25 USE dimphy 26 26 USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac 27 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo 27 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured 28 28 USE mod_phys_lmdz_para 29 29 USE iophy … … 265 265 USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando 266 266 USE VERTICAL_LAYERS_MOD, ONLY: aps,bps 267 USE etat0_limit_unstruct_mod 268 #ifdef CPP_XIOS 269 USE xios, ONLY: xios_update_calendar, xios_context_finalize 270 #endif 271 USE limit_read_mod, ONLY : init_limit_read 272 USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz 273 USE readaerosol_mod, ONLY : init_aero_fromfile 274 USE readaerosolstrato_m, ONLY : init_readaerosolstrato 267 275 268 276 IMPLICIT NONE … … 1165 1173 !albedo SB >>> 1166 1174 real,dimension(6),save :: SFRWL 1175 !$OMP THREADPRIVATE(SFRWL) 1167 1176 !albedo SB <<< 1168 1177 … … 1183 1192 pdtphys=pdtphys_ 1184 1193 CALL update_time(pdtphys) 1194 phys_tstep=NINT(pdtphys) 1195 #ifdef CPP_XIOS 1196 IF (.NOT. debut .AND. is_omp_master) CALL xios_update_calendar(itap+1) 1197 #endif 1185 1198 1186 1199 !====================================================================== … … 1215 1228 1216 1229 IF (first) THEN 1230 CALL init_etat0_limit_unstruct 1231 IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed) 1217 1232 !CR:nvelles variables convection/poches froides 1218 1233 … … 1221 1236 CALL phys_local_var_init 1222 1237 ! 1223 pasphys=pdtphys1224 1238 ! appel a la lecture du run.def physique 1225 1239 CALL conf_phys(ok_journe, ok_mensuel, & … … 1239 1253 CALL phys_state_var_init(read_climoz) 1240 1254 CALL phys_output_var_init 1255 IF(read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz) 1256 1241 1257 print*, '=================================================' 1242 1258 ! … … 1369 1385 ENDIF 1370 1386 1387 tau_aero(:,:,:,:) = 1.e-15 1388 piz_aero(:,:,:,:) = 1. 1389 cg_aero(:,:,:,:) = 0. 1390 1371 1391 IF (aerosol_couple .AND. (config_inca /= "aero" & 1372 1392 .AND. config_inca /= "aeNP ")) THEN … … 1417 1437 ! pour obtenir le meme resultat. 1418 1438 !jyg for fh< 1419 !! dtime=pdtphys 1420 dtime=NINT(pdtphys) 1421 WRITE(lunout,*) 'Pas de temps dtime pdtphys ',dtime,pdtphys 1422 IF (abs(dtime-pdtphys)>1.e-10) THEN 1439 WRITE(lunout,*) 'Pas de temps phys_tstep pdtphys ',phys_tstep,pdtphys 1440 IF (abs(phys_tstep-pdtphys)>1.e-10) THEN 1423 1441 abort_message='pas de temps doit etre entier en seconde pour orchidee et XIOS' 1424 1442 CALL abort_physic(modname,abort_message,1) 1425 1443 ENDIF 1426 1444 !>jyg 1427 IF (MOD(NINT(86400./ dtime),nbapp_rad).EQ.0) THEN1428 radpas = NINT( 86400./ dtime)/nbapp_rad1445 IF (MOD(NINT(86400./phys_tstep),nbapp_rad).EQ.0) THEN 1446 radpas = NINT( 86400./phys_tstep)/nbapp_rad 1429 1447 ELSE 1430 1448 WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', & … … 1436 1454 CALL abort_physic(modname,abort_message,1) 1437 1455 ENDIF 1438 IF (nbapp_cv .EQ. 0) nbapp_cv=86400./ dtime1439 IF (nbapp_wk .EQ. 0) nbapp_wk=86400./ dtime1456 IF (nbapp_cv .EQ. 0) nbapp_cv=86400./phys_tstep 1457 IF (nbapp_wk .EQ. 0) nbapp_wk=86400./phys_tstep 1440 1458 print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk 1441 IF (MOD(NINT(86400./ dtime),nbapp_cv).EQ.0) THEN1442 cvpas_0 = NINT( 86400./ dtime)/nbapp_cv1459 IF (MOD(NINT(86400./phys_tstep),nbapp_cv).EQ.0) THEN 1460 cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv 1443 1461 cvpas = cvpas_0 1444 1462 print *,'physiq, cvpas ',cvpas … … 1452 1470 call abort_physic(modname,abort_message,1) 1453 1471 ENDIF 1454 IF (MOD(NINT(86400./ dtime),nbapp_wk).EQ.0) THEN1455 wkpas = NINT( 86400./ dtime)/nbapp_wk1472 IF (MOD(NINT(86400./phys_tstep),nbapp_wk).EQ.0) THEN 1473 wkpas = NINT( 86400./phys_tstep)/nbapp_wk 1456 1474 print *,'physiq, wkpas ',wkpas 1457 1475 ELSE … … 1465 1483 ENDIF 1466 1484 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1467 1485 CALL init_iophy_new(latitude_deg,longitude_deg) 1486 1487 !=================================================================== 1488 !IM stations CFMIP 1489 nCFMIP=npCFMIP 1490 OPEN(98,file='npCFMIP_param.data',status='old', & 1491 form='formatted',iostat=iostat) 1492 IF (iostat == 0) THEN 1493 READ(98,*,end=998) nCFMIP 1494 998 CONTINUE 1495 CLOSE(98) 1496 CONTINUE 1497 IF(nCFMIP.GT.npCFMIP) THEN 1498 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler' 1499 CALL abort_physic("physiq", "", 1) 1500 ELSE 1501 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP 1502 ENDIF 1503 1504 ! 1505 ALLOCATE(tabCFMIP(nCFMIP)) 1506 ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP)) 1507 ALLOCATE(tabijGCM(nCFMIP)) 1508 ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP)) 1509 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP)) 1510 ! 1511 ! lecture des nCFMIP stations CFMIP, de leur numero 1512 ! et des coordonnees geographiques lonCFMIP, latCFMIP 1513 ! 1514 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, & 1515 lonCFMIP, latCFMIP) 1516 ! 1517 ! identification des 1518 ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la 1519 ! grille de LMDZ 1520 ! 2) indices points tabijGCM de la grille physique 1d sur 1521 ! klon points 1522 ! 3) indices iGCM, jGCM de la grille physique 2d 1523 ! 1524 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, & 1525 tabijGCM, lonGCM, latGCM, iGCM, jGCM) 1526 ! 1527 ELSE 1528 ALLOCATE(tabijGCM(0)) 1529 ALLOCATE(lonGCM(0), latGCM(0)) 1530 ALLOCATE(iGCM(0), jGCM(0)) 1531 ENDIF 1532 1533 #ifdef CPP_IOIPSL 1534 1535 !$OMP MASTER 1536 ! FH : if ok_sync=.true. , the time axis is written at each time step 1537 ! in the output files. Only at the end in the opposite case 1538 ok_sync_omp=.false. 1539 CALL getin('ok_sync',ok_sync_omp) 1540 CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, & 1541 iGCM,jGCM,lonGCM,latGCM, & 1542 jjmp1,nlevSTD,clevSTD,rlevSTD, phys_tstep,ok_veget, & 1543 type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, & 1544 ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, & 1545 read_climoz, phys_out_filestations, & 1546 new_aod, aerosol_couple, & 1547 flag_aerosol_strat, pdtphys, paprs, pphis, & 1548 pplay, lmax_th, ptconv, ptconvth, ivap, & 1549 d_u, d_t, qx, d_qx, zmasse, ok_sync_omp) 1550 !$OMP END MASTER 1551 !$OMP BARRIER 1552 ok_sync=ok_sync_omp 1553 1554 freq_outNMC(1) = ecrit_files(7) 1555 freq_outNMC(2) = ecrit_files(8) 1556 freq_outNMC(3) = ecrit_files(9) 1557 WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1) 1558 WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2) 1559 WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3) 1560 1561 #ifndef CPP_XIOS 1562 CALL ini_paramLMDZ_phy(phys_tstep,nid_ctesGCM) 1563 #endif 1564 1565 #endif 1566 ecrit_reg = ecrit_reg * un_jour 1567 ecrit_tra = ecrit_tra * un_jour 1568 1569 !XXXPB Positionner date0 pour initialisation de ORCHIDEE 1570 date0 = jD_ref 1571 WRITE(*,*) 'physiq date0 : ',date0 1572 ! 1573 1574 ! CALL create_climoz(read_climoz) 1575 CALL init_aero_fromfile(flag_aerosol) !! initialise aero from file for XIOS interpolation (unstructured_grid) 1576 CALL init_readaerosolstrato(flag_aerosol_strat) !! initialise aero strato from file for XIOS interpolation (unstructured_grid) 1577 1578 IF(read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz) 1579 CALL create_etat0_limit_unstruct 1468 1580 CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0) 1581 1469 1582 !jyg< 1470 1583 IF (klon_glo==1) THEN … … 1480 1593 pbl_tke(:,:,:) = 0. 1481 1594 ENDIF ! (iflag_pbl > 1) 1595 ELSE 1596 pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ?? 1482 1597 !>jyg 1483 1598 ENDIF 1599 #ifdef CPP_COSP 1600 1601 IF (ok_cosp) THEN 1602 CALL phys_cosp(itap,phys_tstep,freq_cosp, & 1603 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 1604 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & 1605 klon,klev,longitude_deg,latitude_deg,presnivs,overlap, & 1606 JrNt,ref_liq,ref_ice, & 1607 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 1608 zu10m,zv10m,pphis, & 1609 zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, & 1610 qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, & 1611 prfl(:,1:klev),psfl(:,1:klev), & 1612 pmflxr(:,1:klev),pmflxs(:,1:klev), & 1613 mr_ozone,cldtau, cldemi) 1614 ENDIF 1615 #endif 1616 1617 CALL phys_output_write(itap, pdtphys, paprs, pphis, & 1618 pplay, lmax_th, aerosol_couple, & 1619 ok_ade, ok_aie, ivap, iliq, isol, new_aod, ok_sync,& 1620 ptconv, read_climoz, clevSTD, & 1621 ptconvth, d_u, d_t, qx, d_qx, zmasse, & 1622 flag_aerosol, flag_aerosol_strat, ok_cdnc) 1623 1624 #ifdef CPP_XIOS 1625 IF (is_omp_master) CALL xios_update_calendar(1) 1626 #endif 1627 1484 1628 !IM begin 1485 1629 print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) & … … 1496 1640 ENDIF 1497 1641 1498 CALL printflag( tabcntr0,radpas,ok_journe, & 1499 ok_instan, ok_region ) 1500 ! 1501 IF (ABS(dtime-pdtphys).GT.0.001) THEN 1502 WRITE(lunout,*) 'Pas physique n est pas correct',dtime, & 1503 pdtphys 1504 abort_message='Pas physique n est pas correct ' 1505 ! call abort_physic(modname,abort_message,1) 1506 dtime=pdtphys 1507 ENDIF 1642 ! IF (ABS(phys_tstep-pdtphys).GT.0.001) THEN 1643 ! WRITE(lunout,*) 'Pas physique n est pas correct',phys_tstep, & 1644 ! pdtphys 1645 ! abort_message='Pas physique n est pas correct ' 1646 ! ! call abort_physic(modname,abort_message,1) 1647 ! phys_tstep=pdtphys 1648 ! ENDIF 1508 1649 IF (nlon .NE. klon) THEN 1509 1650 WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, & … … 1519 1660 ENDIF 1520 1661 ! 1521 IF ( dtime*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN1662 IF (phys_tstep*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN 1522 1663 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' 1523 1664 WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne" … … 1581 1722 ! enddo 1582 1723 1583 !=================================================================== 1584 !IM stations CFMIP 1585 nCFMIP=npCFMIP 1586 OPEN(98,file='npCFMIP_param.data',status='old', & 1587 form='formatted',iostat=iostat) 1588 IF (iostat == 0) THEN 1589 READ(98,*,end=998) nCFMIP 1590 998 CONTINUE 1591 CLOSE(98) 1592 CONTINUE 1593 IF(nCFMIP.GT.npCFMIP) THEN 1594 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler' 1595 CALL abort_physic("physiq", "", 1) 1596 ELSE 1597 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP 1598 ENDIF 1599 1600 ! 1601 ALLOCATE(tabCFMIP(nCFMIP)) 1602 ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP)) 1603 ALLOCATE(tabijGCM(nCFMIP)) 1604 ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP)) 1605 ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP)) 1606 ! 1607 ! lecture des nCFMIP stations CFMIP, de leur numero 1608 ! et des coordonnees geographiques lonCFMIP, latCFMIP 1609 ! 1610 CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, & 1611 lonCFMIP, latCFMIP) 1612 ! 1613 ! identification des 1614 ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la 1615 ! grille de LMDZ 1616 ! 2) indices points tabijGCM de la grille physique 1d sur 1617 ! klon points 1618 ! 3) indices iGCM, jGCM de la grille physique 2d 1619 ! 1620 CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, & 1621 tabijGCM, lonGCM, latGCM, iGCM, jGCM) 1622 ! 1623 ELSE 1624 ALLOCATE(tabijGCM(0)) 1625 ALLOCATE(lonGCM(0), latGCM(0)) 1626 ALLOCATE(iGCM(0), jGCM(0)) 1627 ENDIF 1628 ELSE 1629 ALLOCATE(tabijGCM(0)) 1630 ALLOCATE(lonGCM(0), latGCM(0)) 1631 ALLOCATE(iGCM(0), jGCM(0)) 1724 !ELSE 1725 ! ALLOCATE(tabijGCM(0)) 1726 ! ALLOCATE(lonGCM(0), latGCM(0)) 1727 ! ALLOCATE(iGCM(0), jGCM(0)) 1632 1728 ENDIF 1633 1729 … … 1665 1761 ! 1666 1762 ! 1667 lmt_pas = NINT(86400./ dtime* 1.0) ! tous les jours1763 lmt_pas = NINT(86400./phys_tstep * 1.0) ! tous les jours 1668 1764 WRITE(lunout,*)'La frequence de lecture surface est de ', & 1669 1765 lmt_pas … … 1681 1777 ! Initialisation des sorties 1682 1778 !============================================================= 1779 1780 #ifdef CPP_XIOS 1781 ! Get "missing_val" value from XML files (from temperature variable) 1782 !$OMP MASTER 1783 CALL xios_get_field_attr("temp",default_value=missing_val_omp) 1784 !$OMP END MASTER 1785 !$OMP BARRIER 1786 missing_val=missing_val_omp 1787 #endif 1683 1788 1684 1789 #ifdef CPP_XIOS … … 1693 1798 #endif 1694 1799 1695 #ifdef CPP_IOIPSL 1696 1697 !$OMP MASTER 1698 ! FH : if ok_sync=.true. , the time axis is written at each time step 1699 ! in the output files. Only at the end in the opposite case 1700 ok_sync_omp=.false. 1701 CALL getin('ok_sync',ok_sync_omp) 1702 CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, & 1703 iGCM,jGCM,lonGCM,latGCM, & 1704 jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, & 1705 type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, & 1706 ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, & 1707 read_climoz, phys_out_filestations, & 1708 new_aod, aerosol_couple, & 1709 flag_aerosol_strat, pdtphys, paprs, pphis, & 1710 pplay, lmax_th, ptconv, ptconvth, ivap, & 1711 d_u, d_t, qx, d_qx, zmasse, ok_sync_omp) 1712 !$OMP END MASTER 1713 !$OMP BARRIER 1714 ok_sync=ok_sync_omp 1715 1716 freq_outNMC(1) = ecrit_files(7) 1717 freq_outNMC(2) = ecrit_files(8) 1718 freq_outNMC(3) = ecrit_files(9) 1719 WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1) 1720 WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2) 1721 WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3) 1722 1723 #ifndef CPP_XIOS 1724 CALL ini_paramLMDZ_phy(dtime,nid_ctesGCM) 1725 #endif 1726 1727 #endif 1728 ecrit_reg = ecrit_reg * un_jour 1729 ecrit_tra = ecrit_tra * un_jour 1730 1731 !XXXPB Positionner date0 pour initialisation de ORCHIDEE 1732 date0 = jD_ref 1733 WRITE(*,*) 'physiq date0 : ',date0 1800 1801 CALL printflag( tabcntr0,radpas,ok_journe, & 1802 ok_instan, ok_region ) 1734 1803 ! 1735 1804 ! … … 1891 1960 ! on the surface fraction. 1892 1961 ! 1893 CALL change_srf_frac(itap, dtime, days_elapsed+1, &1962 CALL change_srf_frac(itap, phys_tstep, days_elapsed+1, & 1894 1963 pctsrf, fevap, z0m, z0h, agesno, & 1895 1964 falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke) … … 2021 2090 IF (ancien_ok) THEN 2022 2091 ! 2023 d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/ dtime2024 d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/ dtime2025 d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/ dtime2026 d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/ dtime2027 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/ dtime2028 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/ dtime2092 d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/phys_tstep 2093 d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/phys_tstep 2094 d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/phys_tstep 2095 d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/phys_tstep 2096 d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep 2097 d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep 2029 2098 CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d) 2030 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/ dtime2099 d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep 2031 2100 CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d) 2032 d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/ dtime2101 d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/phys_tstep 2033 2102 CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d) 2034 d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/ dtime2103 d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep 2035 2104 ! !! RomP >>> td dyn traceur 2036 2105 IF (nqtot.GT.nqo) THEN ! jyg 2037 2106 DO iq = nqo+1, nqtot ! jyg 2038 d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/ dtime! jyg2107 d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/phys_tstep ! jyg 2039 2108 ENDDO 2040 2109 ENDIF … … 2213 2282 ! bit comparable a l ancienne formulation cycle_diurne=true 2214 2283 ! on integre entre gmtime et gmtime+radpas 2215 zdtime= dtime*REAL(radpas) ! pas de temps du rayonnement (s)2284 zdtime=phys_tstep*REAL(radpas) ! pas de temps du rayonnement (s) 2216 2285 CALL zenang(zlongi,jH_cur,0.0,zdtime, & 2217 2286 latitude_deg,longitude_deg,rmu0,fract) … … 2230 2299 ! premier pas de temps de la physique pendant lequel 2231 2300 ! itaprad=0 2232 zdtime1= dtime*REAL(-MOD(itaprad,radpas)-1)2233 zdtime2= dtime*REAL(radpas-MOD(itaprad,radpas)-1)2301 zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1) 2302 zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1) 2234 2303 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, & 2235 2304 latitude_deg,longitude_deg,rmu0,fract) … … 2237 2306 ! Calcul des poids 2238 2307 ! 2239 zdtime1=- dtime!--on corrige le rayonnement pour representer le2308 zdtime1=-phys_tstep !--on corrige le rayonnement pour representer le 2240 2309 zdtime2=0.0 !--pas de temps de la physique qui se termine 2241 2310 CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, & … … 2295 2364 ! 2296 2365 !-------gustiness calculation-------! 2366 !ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3 2367 gustiness=0 !ym missing init 2368 2297 2369 IF (iflag_gusts==0) THEN 2298 2370 gustiness(1:klon)=0 … … 2315 2387 2316 2388 CALL pbl_surface( & 2317 dtime, date0, itap, days_elapsed+1, &2389 phys_tstep, date0, itap, days_elapsed+1, & 2318 2390 debut, lafin, & 2319 2391 longitude_deg, latitude_deg, rugoro, zrmu0, & … … 2482 2554 DO i = 1, klon 2483 2555 conv_q(i,k) = d_q_dyn(i,k) & 2484 + d_q_vdf(i,k)/ dtime2556 + d_q_vdf(i,k)/phys_tstep 2485 2557 conv_t(i,k) = d_t_dyn(i,k) & 2486 + d_t_vdf(i,k)/ dtime2558 + d_t_vdf(i,k)/phys_tstep 2487 2559 ENDDO 2488 2560 ENDDO … … 2549 2621 abort_message ='reactiver le call conlmd dans physiq.F' 2550 2622 CALL abort_physic (modname,abort_message,1) 2551 ! CALL conlmd ( dtime, paprs, pplay, t_seri, q_seri, conv_q,2623 ! CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q, 2552 2624 ! . d_t_con, d_q_con, 2553 2625 ! . rain_con, snow_con, ibas_con, itop_con) 2554 2626 ELSE IF (iflag_con.EQ.2) THEN 2555 CALL conflx( dtime, paprs, pplay, t_seri, q_seri, &2627 CALL conflx(phys_tstep, paprs, pplay, t_seri, q_seri, & 2556 2628 conv_t, conv_q, -evap, omega, & 2557 2629 d_t_con, d_q_con, rain_con, snow_con, & … … 2629 2701 2630 2702 !jyg< 2631 CALL alpale( debut, itap, dtime, paprs, omega, t_seri, &2703 CALL alpale( debut, itap, phys_tstep, paprs, omega, t_seri, & 2632 2704 alp_offset, it_wape_prescr, wape_prescr, fip_prescr, & 2633 2705 ale_bl_prescr, alp_bl_prescr, & … … 2671 2743 !c CALL concvl (iflag_con,iflag_clos, 2672 2744 CALL concvl (iflag_clos, & 2673 dtime, paprs, pplay, k_upper_cv, t_x,q_x, &2745 phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, & 2674 2746 t_w,q_w,wake_s, & 2675 2747 u_seri,v_seri,tr_seri,nbtr_tmp, & … … 2741 2813 DO k=1,klev 2742 2814 DO i=1,klon 2743 ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/ dtime2744 fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/ dtime2815 ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep 2816 fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep 2745 2817 d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k) 2746 2818 d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k) … … 2754 2826 2755 2827 ! MAF conema3 ne contient pas les traceurs 2756 CALL conema3 ( dtime, &2828 CALL conema3 (phys_tstep, & 2757 2829 paprs,pplay,t_seri,q_seri, & 2758 2830 u_seri,v_seri,tr_seri,ntra, & … … 2886 2958 snow_con(i))*cell_area(i)/REAL(klon) 2887 2959 ENDDO 2888 zx_t = zx_t/za* dtime2960 zx_t = zx_t/za*phys_tstep 2889 2961 WRITE(lunout,*)"Precip=", zx_t 2890 2962 ENDIF … … 2900 2972 ENDDO 2901 2973 DO i = 1, klon 2902 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))* dtime) &2974 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) & 2903 2975 /z_apres(i) 2904 2976 ENDDO … … 2937 3009 M_dwn(i,k) = dnwd0(i,k) 2938 3010 M_up(i,k) = upwd(i,k) 2939 dt_a(i,k) = d_t_con(i,k)/ dtime- ftd(i,k)2940 dq_a(i,k) = d_q_con(i,k)/ dtime- fqd(i,k)3011 dt_a(i,k) = d_t_con(i,k)/phys_tstep - ftd(i,k) 3012 dq_a(i,k) = d_q_con(i,k)/phys_tstep - fqd(i,k) 2941 3013 ENDDO 2942 3014 ENDDO … … 2946 3018 DO k = 1,klev 2947 3019 dt_dwn(:,k)= dt_dwn(:,k)+ & 2948 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/ dtime3020 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep 2949 3021 dq_dwn(:,k)= dq_dwn(:,k)+ & 2950 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/ dtime3022 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep 2951 3023 ENDDO 2952 3024 ELSEIF (iflag_wake==3) THEN … … 2959 3031 ! l'eau se reevapore). 2960 3032 dt_dwn(i,k)= dt_dwn(i,k)+ & 2961 ok_wk_lsp(i)*d_t_lsc(i,k)/ dtime3033 ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep 2962 3034 dq_dwn(i,k)= dq_dwn(i,k)+ & 2963 ok_wk_lsp(i)*d_q_lsc(i,k)/ dtime3035 ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep 2964 3036 ENDIF 2965 3037 ENDDO … … 2969 3041 ! 2970 3042 !calcul caracteristiques de la poche froide 2971 CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &3043 CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, & 2972 3044 t_seri, q_seri, omega, & 2973 3045 dt_dwn, dq_dwn, M_dwn, M_up, & … … 3016 3088 IF (iflag_alp_wk_cond .GT. 0.) THEN 3017 3089 3018 CALL alpale_wk( dtime, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &3090 CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, & 3019 3091 wake_fip) 3020 3092 ELSE … … 3156 3228 ! 3157 3229 ! 3158 CALL alpale_th( dtime, lmax_th, t_seri, cell_area, &3230 CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area, & 3159 3231 cin, s2, n2, & 3160 3232 ale_bl_trig, ale_bl_stat, ale_bl, & … … 3246 3318 ENDIF 3247 3319 ! 3248 CALL fisrtilp( dtime,paprs,pplay, &3320 CALL fisrtilp(phys_tstep,paprs,pplay, & 3249 3321 t_seri, q_seri,ptconv,ratqs, & 3250 3322 d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, & … … 3306 3378 + snow_lsc(i))*cell_area(i)/REAL(klon) 3307 3379 ENDDO 3308 zx_t = zx_t/za* dtime3380 zx_t = zx_t/za*phys_tstep 3309 3381 WRITE(lunout,*)"Precip=", zx_t 3310 3382 ENDIF … … 3526 3598 calday = REAL(days_elapsed + 1) + jH_cur 3527 3599 3528 CALL chemtime(itap+itau_phy-1, date0, dtime, itap)3600 CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap) 3529 3601 IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN 3530 3602 CALL AEROSOL_METEO_CALC( & … … 4072 4144 4073 4145 DO k=1, klev 4074 d_t_swr(:,k)=swradcorr(:)*heat(:,k)* dtime/RDAY4075 d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)* dtime/RDAY4076 d_t_lwr(:,k)=-cool(:,k)* dtime/RDAY4077 d_t_lw0(:,k)=-cool0(:,k)* dtime/RDAY4146 d_t_swr(:,k)=swradcorr(:)*heat(:,k)*phys_tstep/RDAY 4147 d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*phys_tstep/RDAY 4148 d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY 4149 d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY 4078 4150 ENDDO 4079 4151 … … 4131 4203 IF (ok_strato) THEN 4132 4204 4133 CALL drag_noro_strato(0,klon,klev, dtime,paprs,pplay, &4205 CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, & 4134 4206 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 4135 4207 igwd,idx,itest, & … … 4139 4211 4140 4212 ELSE 4141 CALL drag_noro(klon,klev, dtime,paprs,pplay, &4213 CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, & 4142 4214 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 4143 4215 igwd,idx,itest, & … … 4180 4252 IF (ok_strato) THEN 4181 4253 4182 CALL lift_noro_strato(klon,klev, dtime,paprs,pplay, &4254 CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, & 4183 4255 latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, & 4184 4256 igwd,idx,itest, & … … 4188 4260 4189 4261 ELSE 4190 CALL lift_noro(klon,klev, dtime,paprs,pplay, &4262 CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, & 4191 4263 latitude_deg,zmea,zstd,zpic, & 4192 4264 itest, & … … 4208 4280 du_gwd_hines=0. 4209 4281 dv_gwd_hines=0. 4210 CALL hines_gwd(klon, klev, dtime, paprs, pplay, latitude_deg, t_seri, &4282 CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, & 4211 4283 u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, & 4212 4284 du_gwd_hines, dv_gwd_hines) … … 4214 4286 zvstr_gwd_hines=0. 4215 4287 DO k = 1, klev 4216 zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/ dtime&4288 zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep & 4217 4289 * (paprs(:, k)-paprs(:, k+1))/rg 4218 zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/ dtime&4290 zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep & 4219 4291 * (paprs(:, k)-paprs(:, k+1))/rg 4220 4292 ENDDO … … 4227 4299 4228 4300 IF (.not. ok_hines .and. ok_gwd_rando) then 4229 CALL acama_GWD_rando(DTIME, pplay, latitude_deg, t_seri, u_seri, & 4301 ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod 4302 CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, & 4230 4303 v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, & 4231 4304 dv_gwd_front, east_gwstress, west_gwstress) … … 4233 4306 zvstr_gwd_front=0. 4234 4307 DO k = 1, klev 4235 zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/ dtime&4308 zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep & 4236 4309 * (paprs(:, k)-paprs(:, k+1))/rg 4237 zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/ dtime&4310 zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep & 4238 4311 * (paprs(:, k)-paprs(:, k+1))/rg 4239 4312 ENDDO … … 4245 4318 4246 4319 IF (ok_gwd_rando) THEN 4247 CALL FLOTT_GWD_rando( DTIME, pplay, t_seri, u_seri, v_seri, &4320 CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, & 4248 4321 rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, & 4249 4322 du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress) … … 4254 4327 zvstr_gwd_rando=0. 4255 4328 DO k = 1, klev 4256 zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/ dtime&4329 zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep & 4257 4330 * (paprs(:, k)-paprs(:, k+1))/rg 4258 zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/ dtime&4331 zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep & 4259 4332 * (paprs(:, k)-paprs(:, k+1))/rg 4260 4333 ENDDO … … 4276 4349 DO k = 1, klev 4277 4350 DO i = 1, klon 4278 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/ dtime* &4351 zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* & 4279 4352 (paprs(i,k)-paprs(i,k+1))/rg 4280 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/ dtime* &4353 zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* & 4281 4354 (paprs(i,k)-paprs(i,k+1))/rg 4282 4355 ENDDO … … 4299 4372 CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay) 4300 4373 ! ajout de la tendance d'humidite due au methane 4301 d_q_ch4_dtime(:,:) = d_q_ch4(:,:)* dtime4374 d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep 4302 4375 CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, paprs, & 4303 4376 'q_ch4', abortphy,flag_inhib_tend,itap,0) 4304 d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/ dtime4377 d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep 4305 4378 ENDIF 4306 4379 ! … … 4390 4463 4391 4464 4392 CALL drag_noro_strato(addtkeoro,klon,klev, dtime,paprs,pplay, &4465 CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, & 4393 4466 zmea,zstd, zsig, zgam, zthe,zpic,zval, & 4394 4467 igwd,idx,itest, & … … 4431 4504 ! adeclarer 4432 4505 #ifdef CPP_COSP 4433 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/ dtime)).EQ.0) THEN4506 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN 4434 4507 4435 4508 IF (prt_level .GE.10) THEN … … 4439 4512 ! print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=', 4440 4513 ! s ref_liq,ref_ice 4441 CALL phys_cosp(itap, dtime,freq_cosp, &4514 CALL phys_cosp(itap,phys_tstep,freq_cosp, & 4442 4515 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 4443 4516 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & … … 4462 4535 4463 4536 #ifdef CPP_COSP2 4464 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/ dtime)).EQ.0) THEN4537 IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN 4465 4538 4466 4539 IF (prt_level .GE.10) THEN … … 4470 4543 print*,'Dans physiq.F avant appel ' 4471 4544 ! s ref_liq,ref_ice 4472 CALL phys_cosp2(itap, dtime,freq_cosp, &4545 CALL phys_cosp2(itap,phys_tstep,freq_cosp, & 4473 4546 ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, & 4474 4547 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, & … … 4492 4565 IF (ok_airs) then 4493 4566 4494 IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/ dtime)).EQ.0) THEN4567 IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN 4495 4568 write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs 4496 4569 CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,& … … 4547 4620 CALL phytrac ( & 4548 4621 itap, days_elapsed+1, jH_cur, debut, & 4549 lafin, dtime, u, v, t, &4622 lafin, phys_tstep, u, v, t, & 4550 4623 paprs, pplay, pmfu, pmfd, & 4551 4624 pen_u, pde_u, pen_d, pde_d, & … … 4582 4655 cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, & 4583 4656 frac_impa, frac_nucl, & 4584 pphis,cell_area, dtime,itap, &4657 pphis,cell_area,phys_tstep,itap, & 4585 4658 qx(:,:,ivap),da,phi,mp,upwd,dnwd) 4586 4659 … … 4653 4726 4654 4727 CALL chemhook_end ( & 4655 dtime, &4728 phys_tstep, & 4656 4729 pplay, & 4657 4730 t_seri, & … … 4688 4761 DO k = 1, klev 4689 4762 DO i = 1, klon 4690 d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime4691 d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime4692 d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime4693 d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime4694 d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime4763 d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep 4764 d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep 4765 d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep 4766 d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep 4767 d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep 4695 4768 !CR: on ajoute le contenu en glace 4696 4769 IF (nqo.eq.3) THEN 4697 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime4770 d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep 4698 4771 ENDIF 4699 4772 ENDDO … … 4707 4780 DO k = 1, klev 4708 4781 DO i = 1, klon 4709 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime4710 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / dtime4782 ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / phys_tstep 4783 d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / phys_tstep 4711 4784 ENDDO 4712 4785 ENDDO … … 4962 5035 ! write(97) u_seri,v_seri,t_seri,q_seri 4963 5036 ! close(97) 4964 !$OMP MASTER 4965 IF (read_climoz >= 1) THEN 4966 IF (is_mpi_root) THEN 4967 CALL nf95_close(ncid_climoz) 4968 ENDIF 4969 DEALLOCATE(press_edg_climoz) ! pointer 4970 DEALLOCATE(press_cen_climoz) ! pointer 4971 ENDIF 4972 !$OMP END MASTER 5037 5038 IF (is_omp_master) THEN 5039 5040 IF (read_climoz >= 1) THEN 5041 IF (is_mpi_root) CALL nf95_close(ncid_climoz) 5042 DEALLOCATE(press_edg_climoz) ! pointer 5043 DEALLOCATE(press_cen_climoz) ! pointer 5044 ENDIF 5045 5046 ENDIF 5047 #ifdef CPP_XIOS 5048 IF (is_omp_master) CALL xios_context_finalize 5049 #endif 4973 5050 print *,' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1 4974 5051 ENDIF -
LMDZ6/trunk/libf/phylmd/radlwsw_m.F90
r3412 r3435 398 398 cgaero(:,:,:,:)=0. 399 399 lldebug=.FALSE. 400 401 ztopsw_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 402 ztopsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 403 zsolsw_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 404 zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4 400 405 401 406 ! -
LMDZ6/trunk/libf/phylmd/readaerosol.F90
r2841 r3435 4 4 5 5 REAL, SAVE :: not_valid=-333. 6 7 INTEGER, SAVE :: nbp_lon_src 8 !$OMP THREADPRIVATE(nbp_lon_src) 9 INTEGER, SAVE :: nbp_lat_src 10 !$OMP THREADPRIVATE(nbp_lat_src) 11 REAL, ALLOCATABLE, SAVE :: psurf_interp(:,:) 12 !$OMP THREADPRIVATE(psurf_interp) 6 13 7 14 CONTAINS … … 167 174 168 175 176 SUBROUTINE init_aero_fromfile(flag_aerosol) 177 USE netcdf 178 USE mod_phys_lmdz_para 179 USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured 180 USE xios 181 IMPLICIT NONE 182 INTEGER, INTENT(IN) :: flag_aerosol 183 REAL,ALLOCATABLE :: lat_src(:) 184 REAL,ALLOCATABLE :: lon_src(:) 185 CHARACTER(LEN=*),PARAMETER :: file_aerosol='aerosols.nat.nc' 186 CHARACTER(LEN=*),PARAMETER :: file_so4='so4.nat.nc' 187 INTEGER :: klev_src 188 INTEGER :: ierr ,ncid, dimID, varid 189 REAL :: null_array(0) 190 191 IF (flag_aerosol>0 .AND. grid_type==unstructured) THEN 192 193 IF (is_omp_root) THEN 194 195 IF (is_mpi_root) THEN 196 197 IF (nf90_open(TRIM(file_aerosol), NF90_NOWRITE, ncid) /= NF90_NOERR) THEN 198 CALL check_err( nf90_open(TRIM(file_so4), NF90_NOWRITE, ncid), "pb open "//trim(file_so4) ) 199 ENDIF 200 201 ! Read and test longitudes 202 CALL check_err( nf90_inq_dimid(ncid, "lon", dimID),"pb inq dim lon") 203 CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lon_src),"pb inq dim lon") 204 CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" ) 205 ALLOCATE(lon_src(nbp_lon_src)) 206 CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" ) 207 208 ! Read and test latitudes 209 CALL check_err( nf90_inq_dimid(ncid, "lat", dimID),"pb inq dim lat") 210 CALL check_err( nf90_inquire_dimension(ncid, dimID, len = nbp_lat_src),"pb inq dim lat") 211 CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" ) 212 ALLOCATE(lat_src(nbp_lat_src)) 213 CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" ) 214 IF (nf90_inq_dimid(ncid, 'lev', dimid) /= NF90_NOERR) THEN 215 IF (nf90_inq_dimid(ncid, 'presnivs', dimid)/= NF90_NOERR) THEN 216 CALL check_err(nf90_inq_dimid(ncid, 'PRESNIVS', dimid),'dimension lev,PRESNIVS or presnivs not in file') 217 ENDIF 218 ENDIF 219 CALL check_err( nf90_inquire_dimension(ncid, dimid, len = klev_src),"pb inq dim for PRESNIVS or lev" ) 220 CALL check_err( nf90_close(ncid),"pb in close" ) 221 ENDIF 222 223 CALL bcast_mpi(nbp_lat_src) 224 CALL bcast_mpi(nbp_lon_src) 225 CALL bcast_mpi(klev_src) 226 227 IF (is_mpi_root ) THEN 228 CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=nbp_lat_src, jbegin=0, latvalue_1d=lat_src) 229 CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=nbp_lon_src, ibegin=0, lonvalue_1d=lon_src) 230 ELSE 231 CALL xios_set_domain_attr("domain_aerosol",nj_glo=nbp_lat_src, nj=0, jbegin=0, latvalue_1d=null_array ) 232 CALL xios_set_domain_attr("domain_aerosol",ni_glo=nbp_lon_src, ni=0, ibegin=0, lonvalue_1d=null_array) 233 ENDIF 234 CALL xios_set_axis_attr("axis_aerosol",n_glo=klev_src) 235 CALL xios_set_fieldgroup_attr("aerosols", enabled=.TRUE.) 236 237 ENDIF 238 239 ENDIF 240 241 END SUBROUTINE init_aero_fromfile 242 243 244 245 169 246 SUBROUTINE get_aero_fromfile(varname, cyr, filename, klev_src, pt_ap, pt_b, pt_year, psurf_out, load_out) 170 247 !**************************************************************************************** … … 187 264 USE netcdf 188 265 USE dimphy 189 USE mod_grid_phy_lmdz, ONLY: nbp_lon ,nbp_lat, klon_glo, &190 grid2Dto1D_glo 266 USE mod_grid_phy_lmdz, ONLY: nbp_lon_=>nbp_lon, nbp_lat_=>nbp_lat, klon_glo, & 267 grid2Dto1D_glo, grid_type, unstructured 191 268 USE mod_phys_lmdz_para 192 269 USE iophy, ONLY : io_lon, io_lat 193 270 USE print_control_mod, ONLY: lunout 271 USE xios 194 272 195 273 IMPLICIT NONE … … 205 283 REAL, POINTER, DIMENSION(:) :: pt_b ! Pointer for describing the vertical levels 206 284 REAL, POINTER, DIMENSION(:,:,:) :: pt_year ! Pointer-variabale from file, 12 month, grid : klon,klev_src 285 REAL, POINTER, DIMENSION(:,:,:) :: pt_year_mpi ! Pointer-variabale from file, 12 month, grid : klon,klev_src 207 286 REAL, DIMENSION(klon,12), INTENT(OUT) :: psurf_out ! Surface pression for 12 months 287 REAL, DIMENSION(klon_mpi,12) :: psurf_out_mpi ! Surface pression for 12 months 208 288 REAL, DIMENSION(klon,12), INTENT(OUT) :: load_out ! Aerosol mass load in each column 289 REAL, DIMENSION(klon_mpi,12) :: load_out_mpi ! Aerosol mass load in each column 209 290 INTEGER :: nbr_tsteps ! number of month in file read 210 291 … … 220 301 REAL, ALLOCATABLE, DIMENSION(:) :: varktmp 221 302 222 REAL, DIMENSION(nbp_lon,nbp_lat,12) :: psurf_glo2D! Surface pression for 12 months on dynamics global grid303 REAL, ALLOCATABLE :: psurf_glo2D(:,:,:) ! Surface pression for 12 months on dynamics global grid 223 304 REAL, DIMENSION(klon_glo,12) :: psurf_glo1D ! -"- on physical global grid 224 REAL, DIMENSION(nbp_lon,nbp_lat,12) :: load_glo2D! Load for 12 months on dynamics global grid305 REAL, ALLOCATABLE :: load_glo2D(:,:,:) ! Load for 12 months on dynamics global grid 225 306 REAL, DIMENSION(klon_glo,12) :: load_glo1D ! -"- on physical global grid 226 REAL, DIMENSION(nbp_lon,nbp_lat):: vartmp227 REAL, DIMENSION(nbp_lon):: lon_src ! longitudes in file228 REAL, DIMENSION(nbp_lat):: lat_src, lat_src_inv ! latitudes in file307 REAL, ALLOCATABLE, DIMENSION(:,:) :: vartmp 308 REAL, ALLOCATABLE,DIMENSION(:) :: lon_src ! longitudes in file 309 REAL, ALLOCATABLE,DIMENSION(:) :: lat_src, lat_src_inv ! latitudes in file 229 310 LOGICAL :: new_file ! true if new file format detected 230 311 LOGICAL :: invert_lat ! true if the field has to be inverted for latitudes 231 232 312 INTEGER :: nbp_lon, nbp_lat 313 LOGICAL,SAVE :: first=.TRUE. 314 !$OMP THREADPRIVATE(first) 315 316 IF (grid_type==unstructured) THEN 317 nbp_lon=nbp_lon_src 318 nbp_lat=nbp_lat_src 319 ELSE 320 nbp_lon=nbp_lon_ 321 nbp_lat=nbp_lat_ 322 ENDIF 323 324 IF (is_mpi_root) THEN 325 326 ALLOCATE(psurf_glo2D(nbp_lon,nbp_lat,12)) 327 ALLOCATE(load_glo2D(nbp_lon,nbp_lat,12)) 328 ALLOCATE(vartmp(nbp_lon,nbp_lat)) 329 ALLOCATE(lon_src(nbp_lon)) 330 ALLOCATE(lat_src(nbp_lat)) 331 ALLOCATE(lat_src_inv(nbp_lat)) 332 ELSE 333 ALLOCATE(varyear(0,0,0,0)) 334 ALLOCATE(psurf_glo2D(0,0,0)) 335 ALLOCATE(load_glo2D(0,0,0)) 336 ENDIF 337 233 338 ! Deallocate pointers 234 339 IF (ASSOCIATED(pt_ap)) DEALLOCATE(pt_ap) … … 245 350 CALL check_err( nf90_open(TRIM(fname), NF90_NOWRITE, ncid), "pb open "//trim(fname) ) 246 351 352 353 IF (grid_type/=unstructured) THEN 354 247 355 ! Test for equal longitudes and latitudes in file and model 248 356 !**************************************************************************************** 249 357 ! Read and test longitudes 250 CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" )251 CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" )358 CALL check_err( nf90_inq_varid(ncid, 'lon', varid),"pb inq lon" ) 359 CALL check_err( nf90_get_var(ncid, varid, lon_src(:)),"pb get lon" ) 252 360 253 IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN254 WRITE(lunout,*) 'Problem in longitudes read from file : ',TRIM(fname)255 WRITE(lunout,*) 'longitudes in file ', TRIM(fname),' : ', lon_src256 WRITE(lunout,*) 'longitudes in model :', io_lon361 IF (maxval(ABS(lon_src - io_lon)) > 0.001) THEN 362 WRITE(lunout,*) 'Problem in longitudes read from file : ',TRIM(fname) 363 WRITE(lunout,*) 'longitudes in file ', TRIM(fname),' : ', lon_src 364 WRITE(lunout,*) 'longitudes in model :', io_lon 257 365 258 CALL abort_physic('get_aero_fromfile', 'longitudes are not the same in file and model',1)259 END IF260 261 ! Read and test latitudes262 CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" )263 CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" )264 265 ! Invert source latitudes266 DO j = 1, nbp_lat267 lat_src_inv(j) = lat_src(nbp_lat +1 -j)268 END DO269 270 IF (maxval(ABS(lat_src - io_lat)) < 0.001) THEN271 ! Latitudes are the same272 invert_lat=.FALSE.273 ELSE IF (maxval(ABS(lat_src_inv - io_lat)) < 0.001) THEN274 ! Inverted source latitudes correspond to model latitudes275 WRITE(lunout,*) 'latitudes will be inverted for file : ',TRIM(fname)276 invert_lat=.TRUE.277 ELSE278 WRITE(lunout,*) 'Problem in latitudes read from file : ',TRIM(fname)279 WRITE(lunout,*) 'latitudes in file ', TRIM(fname),' : ', lat_src280 WRITE(lunout,*) 'latitudes in model :', io_lat281 CALL abort_physic('get_aero_fromfile', 'latitudes do not correspond between file and model',1)282 END IF283 366 CALL abort_physic('get_aero_fromfile', 'longitudes are not the same in file and model',1) 367 END IF 368 369 ! Read and test latitudes 370 CALL check_err( nf90_inq_varid(ncid, 'lat', varid),"pb inq lat" ) 371 CALL check_err( nf90_get_var(ncid, varid, lat_src(:)),"pb get lat" ) 372 373 ! Invert source latitudes 374 DO j = 1, nbp_lat 375 lat_src_inv(j) = lat_src(nbp_lat +1 -j) 376 END DO 377 378 IF (maxval(ABS(lat_src - io_lat)) < 0.001) THEN 379 ! Latitudes are the same 380 invert_lat=.FALSE. 381 ELSE IF (maxval(ABS(lat_src_inv - io_lat)) < 0.001) THEN 382 ! Inverted source latitudes correspond to model latitudes 383 WRITE(lunout,*) 'latitudes will be inverted for file : ',TRIM(fname) 384 invert_lat=.TRUE. 385 ELSE 386 WRITE(lunout,*) 'Problem in latitudes read from file : ',TRIM(fname) 387 WRITE(lunout,*) 'latitudes in file ', TRIM(fname),' : ', lat_src 388 WRITE(lunout,*) 'latitudes in model :', io_lat 389 CALL abort_physic('get_aero_fromfile', 'latitudes do not correspond between file and model',1) 390 END IF 391 ENDIF 284 392 285 393 ! 2) Check if old or new file is avalabale. … … 487 595 END IF 488 596 489 ! - Invert latitudes if necessary 490 DO imth=1, 12 491 IF (invert_lat) THEN 492 493 ! Invert latitudes for the variable 494 varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly 495 DO k=1,klev_src 496 DO j=1,nbp_lat 497 DO i=1,nbp_lon 498 varyear(i,j,k,imth) = varmth(i,nbp_lat+1-j,k) 499 END DO 500 END DO 501 END DO 597 598 IF (grid_type/=unstructured) THEN 599 ! - Invert latitudes if necessary 600 DO imth=1, 12 601 IF (invert_lat) THEN 602 603 ! Invert latitudes for the variable 604 varmth(:,:,:) = varyear(:,:,:,imth) ! use varmth temporarly 605 DO k=1,klev_src 606 DO j=1,nbp_lat 607 DO i=1,nbp_lon 608 varyear(i,j,k,imth) = varmth(i,nbp_lat+1-j,k) 609 END DO 610 END DO 611 END DO 502 612 503 ! Invert latitudes for surface pressure504 vartmp(:,:) = psurf_glo2D(:,:,imth)505 DO j=1,nbp_lat506 DO i=1,nbp_lon507 psurf_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)508 END DO509 END DO613 ! Invert latitudes for surface pressure 614 vartmp(:,:) = psurf_glo2D(:,:,imth) 615 DO j=1,nbp_lat 616 DO i=1,nbp_lon 617 psurf_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j) 618 END DO 619 END DO 510 620 511 ! Invert latitudes for the load512 vartmp(:,:) = load_glo2D(:,:,imth)513 DO j=1,nbp_lat514 DO i=1,nbp_lon515 load_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j)516 END DO517 END DO518 END IF ! invert_lat621 ! Invert latitudes for the load 622 vartmp(:,:) = load_glo2D(:,:,imth) 623 DO j=1,nbp_lat 624 DO i=1,nbp_lon 625 load_glo2D(i,j,imth)= vartmp(i,nbp_lat+1-j) 626 END DO 627 END DO 628 END IF ! invert_lat 519 629 520 ! Do zonal mead at poles and distribut at whole first and last latitude521 DO k=1, klev_src522 npole=0. ! North pole, j=1523 spole=0. ! South pole, j=nbp_lat524 DO i=1,nbp_lon525 npole = npole + varyear(i,1,k,imth)526 spole = spole + varyear(i,nbp_lat,k,imth)527 END DO528 npole = npole/REAL(nbp_lon)529 spole = spole/REAL(nbp_lon)530 varyear(:,1, k,imth) = npole531 varyear(:,nbp_lat,k,imth) = spole532 END DO533 END DO ! imth630 ! Do zonal mead at poles and distribut at whole first and last latitude 631 DO k=1, klev_src 632 npole=0. ! North pole, j=1 633 spole=0. ! South pole, j=nbp_lat 634 DO i=1,nbp_lon 635 npole = npole + varyear(i,1,k,imth) 636 spole = spole + varyear(i,nbp_lat,k,imth) 637 END DO 638 npole = npole/REAL(nbp_lon) 639 spole = spole/REAL(nbp_lon) 640 varyear(:,1, k,imth) = npole 641 varyear(:,nbp_lat,k,imth) = spole 642 END DO 643 END DO ! imth 534 644 535 ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr)536 IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 3',1)645 ALLOCATE(varyear_glo1D(klon_glo, klev_src, 12), stat=ierr) 646 IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 3',1) 537 647 538 ! Transform from 2D to 1D field 539 CALL grid2Dto1D_glo(varyear,varyear_glo1D) 540 CALL grid2Dto1D_glo(psurf_glo2D,psurf_glo1D) 541 CALL grid2Dto1D_glo(load_glo2D,load_glo1D) 542 648 ! Transform from 2D to 1D field 649 CALL grid2Dto1D_glo(varyear,varyear_glo1D) 650 CALL grid2Dto1D_glo(psurf_glo2D,psurf_glo1D) 651 CALL grid2Dto1D_glo(load_glo2D,load_glo1D) 652 653 ENDIF 654 543 655 ELSE 544 ALLOCATE(varyear_glo1D(0,0,0))656 ALLOCATE(varyear_glo1D(0,0,0)) 545 657 END IF ! is_mpi_root .AND. is_omp_root 546 658 … … 566 678 IF (ASSOCIATED(pt_year)) DEALLOCATE(pt_year) 567 679 ALLOCATE(pt_year(klon, klev_src, 12), stat=ierr) 680 ALLOCATE(pt_year_mpi(klon_mpi, klev_src, 12), stat=ierr) 568 681 IF (ierr /= 0) CALL abort_physic('get_aero_fromfile', 'pb in allocation 5',1) 569 682 570 ! Scatter global field to local domain at local process 571 CALL scatter(varyear_glo1D, pt_year) 572 CALL scatter(psurf_glo1D, psurf_out) 573 CALL scatter(load_glo1D, load_out) 574 683 IF (grid_type==unstructured) THEN 684 IF (is_omp_master) THEN 685 CALL xios_send_field(TRIM(varname)//"_in",varyear) 686 CALL xios_recv_field(TRIM(varname)//"_out",pt_year_mpi) 687 CALL xios_send_field("load_"//TRIM(varname)//"_in",load_glo2D) 688 CALL xios_recv_field("load_"//TRIM(varname)//"_out",load_out_mpi) 689 IF (first) THEN 690 ALLOCATE(psurf_interp(klon_mpi,12)) 691 CALL xios_send_field("psurf_aerosol_in",psurf_glo2D) 692 CALL xios_recv_field("psurf_aerosol_out",psurf_interp) 693 ENDIF 694 ENDIF 695 CALL scatter_omp(pt_year_mpi,pt_year) 696 CALL scatter_omp(load_out_mpi,load_out) 697 CALL scatter_omp(psurf_interp,psurf_out) 698 first=.FALSE. 699 ELSE 700 ! Scatter global field to local domain at local process 701 CALL scatter(varyear_glo1D, pt_year) 702 CALL scatter(psurf_glo1D, psurf_out) 703 CALL scatter(load_glo1D, load_out) 704 ENDIF 575 705 ! 7) Test for negative values 576 706 !**************************************************************************************** -
LMDZ6/trunk/libf/phylmd/readaerosolstrato.F90
r2745 r3435 7 7 USE phys_cal_mod, ONLY : mth_cur 8 8 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, & 9 grid2dto1d_glo 9 grid2dto1d_glo, grid_type, unstructured 10 10 USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root 11 11 USE mod_phys_lmdz_omp_data, ONLY : is_omp_root … … 15 15 USE aero_mod 16 16 USE dimphy 17 USE xios 17 18 18 19 implicit none … … 43 44 real, allocatable:: tauaerstrat_mois(:, :, :) 44 45 real, allocatable:: tauaerstrat_mois_glo(:, :) 46 real, allocatable:: tau_aer_strat_mpi(:, :) 45 47 46 48 ! For NetCDF: … … 87 89 n_lat = size(latitude) 88 90 print *, 'LAT aerosol strato=', n_lat, latitude 89 IF (n_lat.NE.nbp_lat) THEN 90 print *,'Le nombre de lat n est pas egal a nbp_lat' 91 STOP 92 ENDIF 93 91 IF (grid_type/=unstructured) THEN 92 IF (n_lat.NE.nbp_lat) THEN 93 print *,'Le nombre de lat n est pas egal a nbp_lat' 94 STOP 95 ENDIF 96 ENDIF 97 94 98 CALL nf95_inq_varid(ncid_in, "LON", varid) 95 99 CALL nf95_gw_var(ncid_in, varid, longitude) 96 100 n_lon = size(longitude) 97 print *, 'LON aerosol strato=', n_lon, longitude 98 IF (n_lon.NE.nbp_lon) THEN 99 print *,'Le nombre de lon n est pas egal a nbp_lon' 100 STOP 101 ENDIF 102 101 IF (grid_type/=unstructured) THEN 102 print *, 'LON aerosol strato=', n_lon, longitude 103 IF (n_lon.NE.nbp_lon) THEN 104 print *,'Le nombre de lon n est pas egal a nbp_lon' 105 STOP 106 ENDIF 107 ENDIF 108 103 109 CALL nf95_inq_varid(ncid_in, "TIME", varid) 104 110 CALL nf95_gw_var(ncid_in, varid, time) … … 130 136 CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo) 131 137 138 ELSE 139 ALLOCATE(tauaerstrat_mois(0,0,0)) 132 140 ENDIF !--is_mpi_root and is_omp_root 133 141 134 142 !$OMP BARRIER 135 143 144 IF (grid_type==unstructured) THEN 145 IF (is_omp_master) THEN 146 CALL xios_send_field("taustrat_in",tauaerstrat_mois) 147 ALLOCATE(tau_aer_strat_mpi(klon_mpi, klev)) 148 CALL xios_recv_field("taustrat_out",tau_aer_strat_mpi) 149 ELSE 150 ALLOCATE(tau_aer_strat_mpi(0,0)) 151 ENDIF 152 CALL scatter_omp(tau_aer_strat_mpi,tau_aer_strat) 153 ELSE 136 154 !--scatter on all proc 137 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 155 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 156 ENDIF 138 157 139 158 !--keep memory of previous month -
LMDZ6/trunk/libf/phylmd/regr_horiz_time_climoz_m.F90
r3278 r3435 2 2 3 3 USE interpolation, ONLY: locate 4 USE mod_grid_phy_lmdz, ONLY: n lon_ou => nbp_lon, nlat_ou => nbp_lat4 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured 5 5 USE nrtype, ONLY: pi 6 6 USE netcdf, ONLY: NF90_CLOBBER, NF90_FLOAT, NF90_GET_VAR, NF90_OPEN, & … … 11 11 NF95_CLOSE, NF95_ENDDEF, NF95_PUT_ATT, NF95_PUT_VAR, NF95_COPY_ATT 12 12 USE print_control_mod, ONLY: lunout 13 USE dimphy 13 14 IMPLICIT NONE 14 15 PRIVATE … … 16 17 REAL, PARAMETER :: deg2rad=pi/180. 17 18 CHARACTER(LEN=13), PARAMETER :: vars_in(2)=['tro3 ','tro3_daylight'] 19 20 INTEGER :: nlat_ou, nlon_ou 21 REAL, ALLOCATABLE :: latitude_glo(:) 22 !$OMP THREADPRIVATE(latitude_glo) 23 INTEGER, ALLOCATABLE :: ind_cell_glo_glo(:) 24 !$OMP THREADPRIVATE(ind_cell_glo_glo) 18 25 19 26 CONTAINS … … 52 59 USE assert_m, ONLY: assert 53 60 USE cal_tools_m, ONLY: year_len, mid_month 54 USE control_mod, ONLY: anneeref 61 !! USE control_mod, ONLY: anneeref 62 USE time_phylmdz_mod, ONLY: annee_ref 55 63 USE ioipsl, ONLY: ioget_year_len, ioget_calendar 56 64 USE regr_conserv_m, ONLY: regr_conserv … … 58 66 USE regular_lonlat_mod, ONLY: boundslon_reg, boundslat_reg, south, west, east 59 67 USE slopes_m, ONLY: slopes 68 USE xios 69 USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_master, is_omp_master, gather, gather_mpi, bcast_mpi, klon_mpi 70 USE geometry_mod, ONLY : latitude_deg, ind_cell_glo 71 USE mod_grid_phy_lmdz, ONLY: klon_glo 72 60 73 !------------------------------------------------------------------------------- 61 74 ! Arguments: … … 83 96 CHARACTER(LEN=20) :: cal_in ! Calendar 84 97 REAL, ALLOCATABLE :: o3_in3(:,:,:,:,:) ! Ozone climatologies 98 REAL, ALLOCATABLE :: o3_in3bis(:,:,:,:,:) ! Ozone climatologies 85 99 REAL, ALLOCATABLE :: o3_in2 (:,:,:,:) ! Ozone climatologies 100 REAL, ALLOCATABLE :: o3_in2bis(:,:,:,:,:) ! Ozone climatologies 86 101 ! last index: 1 for the day-night average, 2 for the daylight field. 87 102 REAL :: NaN … … 91 106 REAL, ALLOCATABLE :: o3_regr_lonlat(:,:,:,:,:) ! (nlon_ou,nlat_ou,:,0:13 ,:) 92 107 REAL, ALLOCATABLE :: o3_out3 (:,:,:,:,:) ! (nlon_ou,nlat_ou,:,ntim_ou,:) 108 REAL, ALLOCATABLE :: o3_out3_glo (:,:,:,:) ! (nbp_lat,:,ntim_ou,:) 93 109 REAL, ALLOCATABLE :: o3_regr_lat (:,:,:,:) ! (nlat_in,:,0:13 ,:) 94 110 REAL, ALLOCATABLE :: o3_out2 (:,:,:,:) ! (nlat_ou,:,ntim_ou,:) 111 REAL, ALLOCATABLE :: o3_out2_glo (:,:,:,:) ! (nbp_lat,:,ntim_ou,:) 112 REAL, ALLOCATABLE :: o3_out (:,:,:,:) ! (nbp_lat,:,ntim_ou,:) 95 113 ! Dimension number | Interval | Contains | For variables: 96 114 ! 1 (longitude) | [rlonu(i-1), rlonu(i)] | rlonv(i) | all … … 116 134 INTEGER, ALLOCATABLE :: sta(:), cnt(:) 117 135 CHARACTER(LEN=80) :: sub, dim_nam, msg 118 !------------------------------------------------------------------------------- 119 sub="regr_horiz_time_climoz" 120 WRITE(lunout,*)"Call sequence information: "//TRIM(sub) 121 CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz") 122 123 CALL NF95_OPEN("climoz.nc" , NF90_NOWRITE, fID_in) 124 lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==NF90_NOERR 125 lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==NF90_NOERR 126 127 !--- Get coordinates from the input file. Converts lon/lat in radians. 128 ! Few inversions because "regr_conserv" and gcm need ascending vectors. 129 CALL NF95_INQ_VARID(fID_in, vars_in(1), varid) 130 CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims) 131 l3D=ndims==4; l2D=ndims==3 132 IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields." 133 IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields." 134 DO i=1,ndims 135 CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln) 136 CALL NF95_INQ_VARID(fID_in, dim_nam, varid) 137 ii=i; IF(l2D) ii=i+1 !--- ndims==3:NO LONGITUDE 138 SELECT CASE(ii) 139 CASE(1) !--- LONGITUDE 140 CALL NF95_GW_VAR(fID_in, varid, lon_in) 141 ldec_lon=lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1) 142 nlon_in=dln; lon_in=lon_in*deg2rad 143 CASE(2) !--- LATITUDE 144 CALL NF95_GW_VAR(fID_in, varid, lat_in) 145 ldec_lat=lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1) 146 nlat_in=dln; lat_in=lat_in*deg2rad 147 CASE(3) !--- PRESSURE LEVELS 148 CALL NF95_GW_VAR(fID_in, varid, lev_in) 149 ldec_lev=lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1) 150 nlev_in=dln 151 CALL NF95_GET_ATT(fID_in, varid, "units", press_unit) 152 k=LEN_TRIM(press_unit) 153 DO WHILE(ICHAR(press_unit(k:k))==0) 154 press_unit(k:k)=' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR 155 END DO 156 IF(press_unit == "Pa") THEN 157 lev_in = lev_in/100. !--- CONVERT TO hPa 158 ELSE IF(press_unit /= "hPa") THEN 159 CALL abort_physic(sub, "the only recognized units are Pa and hPa.",1) 160 END IF 161 CASE(4) !--- TIME 162 CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in) 163 cal_in='gregorian' 164 IF(NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=NF90_NOERR) & 165 WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'// & 166 TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".' 167 k=LEN_TRIM(cal_in) 168 DO WHILE(ICHAR(cal_in(k:k))==0) 169 cal_in(k:k)=' '; k=LEN_TRIM(cal_in) !--- REMOVE NULL END CHAR 170 END DO 171 END SELECT 172 END DO 173 174 !--- Longitudes management: 175 ! * Need to shift data if the origin of input file longitudes /= -pi 176 ! * Need to add some margin in longitude to ensure input interval contains 177 ! all the output intervals => at least one longitudes slice has to be 178 ! duplicated, possibly more for undersampling. 179 IF(l3D) THEN 180 !--- Compute input edges longitudes vector (no end point yet) 181 ALLOCATE(v1(nlon_in+1)) 182 v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi 183 FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2. 184 v1(nlon_in+1)=v1(1)+2.*pi 185 DEALLOCATE(lon_in) 186 187 !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west) 188 v1=v1+2*pi*REAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi))) 136 REAL :: null_array(0) 137 LOGICAL,SAVE :: first=.TRUE. 138 !$OMP THREADPRIVATE(first) 139 REAL, ALLOCATABLE :: test_o3_in(:,:) 140 REAL, ALLOCATABLE :: test_o3_out(:) 141 142 143 IF (grid_type==unstructured) THEN 144 IF (first) THEN 145 IF (is_master) THEN 146 ALLOCATE(latitude_glo(klon_glo)) 147 ALLOCATE(ind_cell_glo_glo(klon_glo)) 148 ELSE 149 ALLOCATE(latitude_glo(0)) 150 ALLOCATE(ind_cell_glo_glo(0)) 151 ENDIF 152 CALL gather(latitude_deg, latitude_glo) 153 CALL gather(ind_cell_glo, ind_cell_glo_glo) 154 ENDIF 155 ENDIF 156 157 IF (is_omp_master) THEN 158 nlat_ou=nbp_lat 159 nlon_ou=nbp_lon 160 161 !------------------------------------------------------------------------------- 162 IF (is_mpi_root) THEN 163 sub="regr_horiz_time_climoz" 164 WRITE(lunout,*)"Call sequence information: "//TRIM(sub) 165 CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz") 166 167 CALL NF95_OPEN("climoz.nc" , NF90_NOWRITE, fID_in) 168 lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==NF90_NOERR 169 lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==NF90_NOERR 170 171 !--- Get coordinates from the input file. Converts lon/lat in radians. 172 ! Few inversions because "regr_conserv" and gcm need ascending vectors. 173 CALL NF95_INQ_VARID(fID_in, vars_in(1), varid) 174 CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims) 175 l3D=ndims==4; l2D=ndims==3 176 IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields." 177 IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields." 178 DO i=1,ndims 179 CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln) 180 CALL NF95_INQ_VARID(fID_in, dim_nam, varid) 181 ii=i; IF(l2D) ii=i+1 !--- ndims==3:NO LONGITUDE 182 SELECT CASE(ii) 183 CASE(1) !--- LONGITUDE 184 CALL NF95_GW_VAR(fID_in, varid, lon_in) 185 ldec_lon=lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1) 186 nlon_in=dln; lon_in=lon_in*deg2rad 187 CASE(2) !--- LATITUDE 188 CALL NF95_GW_VAR(fID_in, varid, lat_in) 189 ldec_lat=lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1) 190 nlat_in=dln; lat_in=lat_in*deg2rad 191 CASE(3) !--- PRESSURE LEVELS 192 CALL NF95_GW_VAR(fID_in, varid, lev_in) 193 ldec_lev=lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1) 194 nlev_in=dln 195 CALL NF95_GET_ATT(fID_in, varid, "units", press_unit) 196 k=LEN_TRIM(press_unit) 197 DO WHILE(ICHAR(press_unit(k:k))==0) 198 press_unit(k:k)=' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR 199 END DO 200 IF(press_unit == "Pa") THEN 201 lev_in = lev_in/100. !--- CONVERT TO hPa 202 ELSE IF(press_unit /= "hPa") THEN 203 CALL abort_physic(sub, "the only recognized units are Pa and hPa.",1) 204 END IF 205 CASE(4) !--- TIME 206 CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in) 207 cal_in='gregorian' 208 IF(NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=NF90_NOERR) & 209 WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'// & 210 TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".' 211 k=LEN_TRIM(cal_in) 212 DO WHILE(ICHAR(cal_in(k:k))==0) 213 cal_in(k:k)=' '; k=LEN_TRIM(cal_in) !--- REMOVE NULL END CHAR 214 END DO 215 END SELECT 216 END DO 189 217 190 218 !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west) 191 219 dx1=locate(v1,boundslon_reg(1,west))-1 192 220 v1=CSHIFT(v1,SHIFT=dx1,DIM=1); v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi 193 194 221 !--- Extend input longitudes vector until last interval contains boundslon_reg(nlon_ou,east) 195 222 dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO 196 223 197 !--- Final edges longitudes vector (with margin and end point) 198 ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi] 199 DEALLOCATE(v1) 200 END IF 201 202 !--- Compute sinus of intervals edges latitudes: 203 ALLOCATE(sinlat_in_edge(nlat_in+1)) 204 sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1. 205 FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.) 206 DEALLOCATE(lat_in) 207 208 !--- Prepare quantities for time interpolation 209 tmidmonth=mid_month(anneeref, cal_in) 210 IF(interpt) THEN 211 ntim_ou=ioget_year_len(anneeref) 212 ALLOCATE(tmidday(ntim_ou)) 213 tmidday=[(REAL(k)-0.5,k=1,ntim_ou)] 214 CALL ioget_calendar(cal_ou) 215 ELSE 216 ntim_ou=14 217 cal_ou=cal_in 218 END IF 219 220 !--- Create the output file and get the variable IDs: 221 CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, & 222 ndims, cal_ou) 223 224 !--- Write remaining coordinate variables: 225 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 226 IF( interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 227 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 228 229 !--- Check for contiguous years: 230 ib=0; ie=13 231 IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE. 232 WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...' 233 ELSE 234 IF( lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).' 235 IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity." 236 IF( lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).' 237 IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity." 238 IF(.NOT.lprev) ib=1 239 IF(.NOT.lnext) ie=12 240 END IF 241 ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1 242 IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1] 243 IF(l2D) cnt=[ nlat_in,nlev_in,1] 244 IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz)) 245 IF(l2D) ALLOCATE(o3_in2( nlat_in,nlev_in,ib:ie,read_climoz)) 246 247 !--- Read full current file and one record each available contiguous file 248 DO iv=1,read_climoz 249 msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv)) 250 CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv)) 251 IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv)) 252 IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2( :,:,1:12,iv)) 253 CALL handle_err(TRIM(msg), ncerr, fID_in) 254 IF(lprev) THEN; sta(ndims)=12 255 CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv)) 256 IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt) 257 IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2( :,:, 0,iv),sta,cnt) 258 CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m) 224 IF (first) THEN 225 first=.FALSE. 226 RETURN 227 ENDIF 228 ENDIF 229 230 231 IF (is_mpi_root) THEN 232 !--- Longitudes management: 233 ! * Need to shift data if the origin of input file longitudes /= -pi 234 ! * Need to add some margin in longitude to ensure input interval contains 235 ! all the output intervals => at least one longitudes slice has to be 236 ! duplicated, possibly more for undersampling. 237 IF(l3D) THEN 238 IF (grid_type==unstructured) THEN 239 dx2=0 240 ELSE 241 !--- Compute input edges longitudes vector (no end point yet) 242 ALLOCATE(v1(nlon_in+1)) 243 v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi 244 FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2. 245 v1(nlon_in+1)=v1(1)+2.*pi 246 DEALLOCATE(lon_in) 247 248 !--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west) 249 v1=v1+2*pi*REAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi))) 250 251 !--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west) 252 dx1=locate(v1,boundslon_reg(1,west))-1 253 v1=CSHIFT(v1,SHIFT=dx1,DIM=1) 254 v1(nlon_in-dx1+1:)=v1(nlon_in-dx1+1:)+2.*pi 255 256 !--- Extend input longitudes vector until last interval contains boundslon_reg(nlat_ou,east) 257 dx2=0; DO WHILE(v1(1+dx2)+2.*pi<boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO 258 259 !--- Final edges longitudes vector (with margin and end point) 260 ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi] 261 DEALLOCATE(v1) 262 ENDIF 263 END IF 264 265 !--- Compute sinus of intervals edges latitudes: 266 ALLOCATE(sinlat_in_edge(nlat_in+1)) 267 sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1. 268 FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.) 269 DEALLOCATE(lat_in) 270 271 272 273 !--- Check for contiguous years: 274 ib=0; ie=13 275 IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE. 276 WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...' 277 ELSE 278 IF( lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).' 279 IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity." 280 IF( lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).' 281 IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity." 282 IF(.NOT.lprev) ib=1 283 IF(.NOT.lnext) ie=12 284 END IF 285 ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1 286 IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1] 287 IF(l2D) cnt=[ nlat_in,nlev_in,1] 288 IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz)) 289 IF(l2D) ALLOCATE(o3_in2( nlat_in,nlev_in,ib:ie,read_climoz)) 290 291 !--- Read full current file and one record each available contiguous file 292 DO iv=1,read_climoz 293 msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv)) 294 CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv)) 295 IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv)) 296 IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2( :,:,1:12,iv)) 297 CALL handle_err(TRIM(msg), ncerr, fID_in) 298 IF(lprev) THEN; sta(ndims)=12 299 CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv)) 300 IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt) 301 IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2( :,:, 0,iv),sta,cnt) 302 CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m) 303 END IF 304 IF(lnext) THEN; sta(ndims)=1 305 CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv)) 306 IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt) 307 IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2( :,:,13,iv),sta,cnt) 308 CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p) 309 END IF 310 END DO 311 IF(lprev.OR.lnext) DEALLOCATE(sta,cnt) 312 IF(lprev) CALL NF95_CLOSE(fID_in_m) 313 IF(lnext) CALL NF95_CLOSE(fID_in_p) 314 315 !--- Revert decreasing coordinates vector 316 IF(l3D) THEN 317 IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:) 318 IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:) 319 IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:) 320 321 IF (grid_type /= unstructured) THEN 322 !--- Shift values for longitude and duplicate some longitudes slices 323 o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1) 324 o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:) 325 ENDIF 326 ELSE 327 IF(ldec_lat) o3_in2 = o3_in2( nlat_in:1:-1,:,:,:) 328 IF(ldec_lev) o3_in2 = o3_in2( :,nlev_in:1:-1,:,:) 329 END IF 330 331 !--- Deal with missing values 332 DO m=1, read_climoz 333 WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m 334 IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= NF90_NOERR) THEN 335 IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= NF90_NOERR) THEN 336 WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE 337 END IF 338 END IF 339 WRITE(lunout,*)TRIM(msg)//": missing value attribute found." 340 WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better." 341 342 !--- Check top layer contains no NaNs & search NaNs from top to ground 343 msg=TRIM(sub)//": NaNs in top layer !" 344 IF(l3D) THEN 345 IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1) 346 DO k = 2,nlev_in 347 WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m) 348 END DO 349 ELSE 350 IF(ANY(o3_in2( :,1,:,m)==NaN)) THEN 351 WRITE(lunout,*)msg 352 !--- Fill in latitudes where all values are missing 353 DO l=1,nmth_in 354 !--- Next to south pole 355 j=1; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO 356 IF(j>1) & 357 o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1) 358 !--- Next to north pole 359 j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO 360 IF(j<nlat_in) & 361 o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j) 362 END DO 363 END IF 364 365 !--- Fill in high latitudes missing values 366 !--- Highest level been filled-in, so has always valid values. 367 DO k = 2,nlev_in 368 WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m) 369 END DO 370 END IF 371 END DO 372 373 ENDIF 374 375 !============================================================================= 376 IF(l3D) THEN !=== 3D FIELDS 377 !============================================================================= 378 IF (grid_type==unstructured) THEN 379 nlat_ou=klon_mpi 380 381 IF (is_mpi_root) THEN 382 ALLOCATE(o3_in3bis(nlon_in,nlat_in,nlev_in,0:13,read_climoz)) 383 o3_in3bis(:,:,:,ib:ie,:)=o3_in3(1:nlon_in,:,:,ib:ie,:) 384 ELSE 385 ALLOCATE(o3_in3bis(0,0,0,0,read_climoz)) 386 ENDIF 387 ALLOCATE(o3_regr_lonlat(1, nlat_ou, nlev_in, 0:13, read_climoz)) 388 389 CALL xios_send_field("tro3_in",o3_in3bis(:,:,:,:,:)) 390 CALL xios_recv_field("tro3_out",o3_regr_lonlat(1,:,:,:,:)) 391 392 ELSE 393 394 !--- Regrid in longitude 395 ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz)) 396 CALL regr_conserv(1, o3_in3, xs = lon_in_edge, & 397 xt = [boundslon_reg(1,west),boundslon_reg(:,east)], & 398 vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge)) 399 DEALLOCATE(o3_in3) 400 401 !--- Regrid in latitude: averaging with respect to SIN(lat) is 402 ! equivalent to weighting by COS(lat) 403 !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing) 404 ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz)) 405 CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge, & 406 xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], & 407 vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:), & 408 slope = slopes(2,o3_regr_lon, sinlat_in_edge)) 409 DEALLOCATE(o3_regr_lon) 410 411 ENDIF 412 413 !--- Duplicate previous/next record(s) if they are not available 414 IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:) 415 IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:) 416 417 !--- Regrid in time by linear interpolation: 418 ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz)) 419 IF( interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3) 420 IF(.NOT.interpt) o3_out3=o3_regr_lonlat 421 DEALLOCATE(o3_regr_lonlat) 422 423 nlat_ou=nbp_lat 424 IF (grid_type==unstructured) THEN 425 CALL xios_send_field('o3_out',o3_out3) 426 ndims=3 427 ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 428 CALL gather_mpi(o3_out3(1,:,:,:,:), o3_out3_glo) 429 ENDIF 430 431 !--- Create the output file and get the variable IDs: 432 CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, & 433 ndims, cal_ou) 434 435 IF (is_mpi_root) THEN 436 !--- Write remaining coordinate variables: 437 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 438 IF( interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 439 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 440 441 !--- Write to file (the order of "rlatu" is inverted in the output file): 442 IF (grid_type==unstructured) THEN 443 444 ALLOCATE(o3_out(nlat_ou, nlev_in, ntim_ou, read_climoz)) 445 DO i=1,klon_glo 446 o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out3_glo(i,:,:,:) 447 ENDDO 448 449 DO m = 1, read_climoz 450 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m)) 451 END DO 452 453 ELSE 454 DO m = 1, read_climoz 455 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m)) 456 END DO 457 ENDIF 458 CALL NF95_CLOSE(fID_ou) 459 460 461 ENDIF 462 463 464 !============================================================================= 465 ELSE !=== ZONAL FIELDS 466 !============================================================================= 467 468 IF (grid_type==unstructured) THEN 469 nlat_ou=klon_mpi 470 471 IF (is_mpi_root) THEN 472 ALLOCATE(o3_in2bis(8,nlat_in,nlev_in,0:13,read_climoz)) 473 o3_in2bis(:,:,:,ib:ie,:)=SPREAD(o3_in2,1,8) 474 ELSE 475 ALLOCATE(o3_in2bis(0,0,0,0,read_climoz)) 476 ENDIF 477 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 478 CALL xios_send_field("tro3_in",o3_in2bis(:,:,:,:,:)) 479 CALL xios_recv_field("tro3_out",o3_regr_lat(:,:,:,:)) 480 IF(.NOT.lprev) o3_regr_lat(:,:, 0, :) = o3_regr_lat(:,:,12,:) 481 IF(.NOT.lnext) o3_regr_lat(:,:,13, :) = o3_regr_lat(:,:, 1,:) 482 483 484 ELSE 485 !--- Regrid in latitude: averaging with respect to SIN(lat) is 486 ! equivalent to weighting by COS(lat) 487 !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing) 488 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 489 CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge, & 490 xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], & 491 vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:), & 492 slope = slopes(1,o3_in2, sinlat_in_edge)) 493 DEALLOCATE(o3_in2) 494 495 !--- Duplicate previous/next record(s) if they are not available 496 IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:) 497 IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:) 498 499 ENDIF 500 501 !--- Regrid in time by linear interpolation: 502 ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz)) 503 IF( interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2) 504 IF(.NOT.interpt) o3_out2=o3_regr_lat 505 DEALLOCATE(o3_regr_lat) 506 507 nlat_ou=nbp_lat 508 509 IF (grid_type==unstructured) THEN 510 ndims=3 511 ALLOCATE(o3_out2_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 512 CALL gather_mpi(o3_out2, o3_out2_glo) 513 ENDIF 514 515 !--- Create the output file and get the variable IDs: 516 CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, & 517 ndims, cal_ou) 518 519 IF (is_mpi_root) THEN 520 521 !--- Write remaining coordinate variables: 522 CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in) 523 IF( interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday) 524 IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth) 525 526 IF (grid_type==unstructured) THEN 527 528 ALLOCATE(o3_out3_glo(nlat_ou, nlev_in, ntim_ou, read_climoz)) 529 DO i=1,klon_glo 530 o3_out(ind_cell_glo_glo(i),:,:,:)=o3_out2_glo(i,:,:,:) 531 ENDDO 532 533 534 DO m = 1, read_climoz 535 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out(nlat_ou:1:-1,:,:,m)) 536 END DO 537 ELSE 538 !--- Write to file (the order of "rlatu" is inverted in the output file): 539 DO m = 1, read_climoz 540 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m)) 541 END DO 542 ENDIF 543 544 CALL NF95_CLOSE(fID_ou) 545 546 ENDIF 547 548 !============================================================================= 259 549 END IF 260 IF(lnext) THEN; sta(ndims)=1 261 CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv)) 262 IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt) 263 IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2( :,:,13,iv),sta,cnt) 264 CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p) 265 END IF 266 END DO 267 IF(lprev.OR.lnext) DEALLOCATE(sta,cnt) 268 IF(lprev) CALL NF95_CLOSE(fID_in_m) 269 IF(lnext) CALL NF95_CLOSE(fID_in_p) 270 271 !--- Revert decreasing coordinates vector 272 IF(l3D) THEN 273 IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:) 274 IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:) 275 IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:) 276 !--- Shift values for longitude and duplicate some longitudes slices 277 o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1) 278 o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:) 279 ELSE 280 IF(ldec_lat) o3_in2 = o3_in2( nlat_in:1:-1,:,:,:) 281 IF(ldec_lev) o3_in2 = o3_in2( :,nlev_in:1:-1,:,:) 282 END IF 283 284 !--- Deal with missing values 285 DO m=1, read_climoz 286 WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m 287 IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= NF90_NOERR) THEN 288 IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= NF90_NOERR) THEN 289 WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE 290 END IF 291 END IF 292 WRITE(lunout,*)TRIM(msg)//": missing value attribute found." 293 WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better." 294 295 !--- Check top layer contains no NaNs & search NaNs from top to ground 296 msg=TRIM(sub)//": NaNs in top layer !" 297 IF(l3D) THEN 298 IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1) 299 DO k = 2,nlev_in 300 WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m) 301 END DO 302 ELSE 303 IF(ANY(o3_in2( :,1,:,m)==NaN)) THEN 304 WRITE(lunout,*)msg 305 !--- Fill in latitudes where all values are missing 306 DO l=1,nmth_in 307 !--- Next to south pole 308 j=1; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO 309 IF(j>1) & 310 o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1) 311 !--- Next to north pole 312 j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO 313 IF(j<nlat_in) & 314 o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j) 315 END DO 316 END IF 317 318 !--- Fill in high latitudes missing values 319 !--- Highest level been filled-in, so has always valid values. 320 DO k = 2,nlev_in 321 WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m) 322 END DO 323 END IF 324 END DO 325 CALL NF95_CLOSE(fID_in) 326 327 !============================================================================= 328 IF(l3D) THEN !=== 3D FIELDS 329 !============================================================================= 330 !--- Regrid in longitude 331 ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz)) 332 CALL regr_conserv(1, o3_in3, xs = lon_in_edge, & 333 xt = [boundslon_reg(1,west),boundslon_reg(:,east)], & 334 vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge)) 335 DEALLOCATE(o3_in3) 336 337 !--- Regrid in latitude: averaging with respect to SIN(lat) is 338 ! equivalent to weighting by COS(lat) 339 !--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing) 340 ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz)) 341 CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge, & 342 xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], & 343 vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:), & 344 slope = slopes(2,o3_regr_lon, sinlat_in_edge)) 345 DEALLOCATE(o3_regr_lon) 346 347 !--- Duplicate previous/next record(s) if they are not available 348 IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:) 349 IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:) 350 351 !--- Regrid in time by linear interpolation: 352 ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz)) 353 IF( interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3) 354 IF(.NOT.interpt) o3_out3=o3_regr_lonlat 355 DEALLOCATE(o3_regr_lonlat) 356 357 !--- Write to file (the order of "rlatu" is inverted in the output file): 358 DO m = 1, read_climoz 359 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m)) 360 END DO 361 362 !============================================================================= 363 ELSE !=== ZONAL FIELDS 364 !============================================================================= 365 !--- Regrid in latitude: averaging with respect to SIN(lat) is 366 ! equivalent to weighting by COS(lat) 367 !--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing) 368 ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz)) 369 CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge, & 370 xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], & 371 vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:), & 372 slope = slopes(1,o3_in2, sinlat_in_edge)) 373 DEALLOCATE(o3_in2) 374 375 !--- Duplicate previous/next record(s) if they are not available 376 IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:) 377 IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:) 378 379 !--- Regrid in time by linear interpolation: 380 ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz)) 381 IF( interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2) 382 IF(.NOT.interpt) o3_out2=o3_regr_lat 383 DEALLOCATE(o3_regr_lat) 384 385 !--- Write to file (the order of "rlatu" is inverted in the output file): 386 DO m = 1, read_climoz 387 CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m)) 388 END DO 389 390 !============================================================================= 391 END IF 392 !============================================================================= 393 394 CALL NF95_CLOSE(fID_ou) 395 550 !============================================================================= 551 552 IF (is_mpi_root) CALL NF95_CLOSE(fID_in) 553 554 ENDIF ! is_omp_master 555 556 first=.FALSE. 396 557 END SUBROUTINE regr_horiz_time_climoz 397 558 ! … … 408 569 !------------------------------------------------------------------------------- 409 570 USE regular_lonlat_mod, ONLY: lon_reg, lat_reg 571 USE regular_lonlat_mod, ONLY: lon_reg, lat_reg 572 USE mod_phys_lmdz_para, ONLY: is_mpi_root 573 USE mod_grid_phy_lmdz, ONLY: klon_glo 574 ! 410 575 !------------------------------------------------------------------------------- 411 576 ! Arguments: … … 419 584 INTEGER :: dlonID, dlatID, dlevID, dtimID, dIDs(4) 420 585 INTEGER :: vlonID, vlatID, ncerr, is 586 REAL,ALLOCATABLE :: latitude_glo_(:) 421 587 CHARACTER(LEN=80) :: sub 422 !------------------------------------------------------------------------------- 423 sub="prepare_out" 424 WRITE(lunout,*)"CALL sequence information: "//TRIM(sub) 425 CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou) 588 INTEGER :: i 589 590 591 !------------------------------------------------------------------------------- 592 593 IF (is_mpi_root) THEN 594 sub="prepare_out" 595 WRITE(lunout,*)"CALL sequence information: "//TRIM(sub) 596 CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou) 426 597 427 598 !--- Dimensions: 428 IF(ndims==4) &429 CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID)430 CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID)431 CALL NF95_DEF_DIM(fID_ou, "plev", nlev_in, dlevID)432 CALL NF95_DEF_DIM(fID_ou, "time", ntim_ou, dtimID)433 434 !--- Define coordinate variables:435 IF(ndims==4) &436 CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID)437 CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID)438 CALL NF95_DEF_VAR(fID_ou, "plev", NF90_FLOAT, dlevID, vlevID)439 CALL NF95_DEF_VAR(fID_ou, "time", NF90_FLOAT, dtimID, vtimID)440 IF(ndims==4) &441 CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east")442 CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north")443 CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar")444 CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1")445 IF(ndims==4) &446 CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude")447 CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude")448 CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure")449 CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time")450 CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name", "air pressure")451 CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar", cal_ou)599 IF(ndims==4) & 600 CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID) 601 CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID) 602 CALL NF95_DEF_DIM(fID_ou, "plev", nlev_in, dlevID) 603 CALL NF95_DEF_DIM(fID_ou, "time", ntim_ou, dtimID) 604 605 !--- Define coordinate variables: 606 IF(ndims==4) & 607 CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID) 608 CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID) 609 CALL NF95_DEF_VAR(fID_ou, "plev", NF90_FLOAT, dlevID, vlevID) 610 CALL NF95_DEF_VAR(fID_ou, "time", NF90_FLOAT, dtimID, vtimID) 611 IF(ndims==4) & 612 CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east") 613 CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north") 614 CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar") 615 CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1") 616 IF(ndims==4) & 617 CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude") 618 CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude") 619 CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure") 620 CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time") 621 CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name", "air pressure") 622 CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar", cal_ou) 452 623 453 624 !--- Define the main variables: 454 IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID]455 IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID]456 CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1))457 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction")458 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone&625 IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID] 626 IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID] 627 CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1)) 628 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction") 629 CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone& 459 630 &_in_air") 460 IF(SIZE(vID_ou) == 2) THEN461 CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2))462 CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da&463 &ylight")464 END IF631 IF(SIZE(vID_ou) == 2) THEN 632 CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2)) 633 CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da& 634 &ylight") 635 END IF 465 636 466 637 !--- Global attributes: 467 638 ! The following commands, copying attributes, may fail. That is OK. 468 639 ! It should just mean that the attribute is not defined in the input file. 469 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr) 470 CALL handle_err_copy_att("Conventions") 471 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title", fID_ou,NF90_GLOBAL, ncerr) 472 CALL handle_err_copy_att("title") 473 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr) 474 CALL handle_err_copy_att("institution") 475 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source", fID_ou,NF90_GLOBAL, ncerr) 476 CALL handle_err_copy_att("source") 477 CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ") 478 CALL NF95_ENDDEF(fID_ou) 479 480 !--- Write one of the coordinate variables: 481 IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad) 482 CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad) 483 ! (convert from rad to degrees and sort in ascending order) 484 640 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr) 641 CALL handle_err_copy_att("Conventions") 642 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title", fID_ou,NF90_GLOBAL, ncerr) 643 CALL handle_err_copy_att("title") 644 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr) 645 CALL handle_err_copy_att("institution") 646 CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source", fID_ou,NF90_GLOBAL, ncerr) 647 CALL handle_err_copy_att("source") 648 CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ") 649 CALL NF95_ENDDEF(fID_ou) 650 651 IF (grid_type==unstructured) THEN 652 ALLOCATE(latitude_glo_(klon_glo)) 653 DO i=1,klon_glo 654 latitude_glo_(ind_cell_glo_glo(i))=latitude_glo(i) 655 ENDDO 656 CALL NF95_PUT_VAR(fID_ou, vlatID, latitude_glo_) 657 ELSE 658 !--- Write one of the coordinate variables: 659 IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad) 660 CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad) 661 ! (convert from rad to degrees and sort in ascending order) 662 ENDIF 663 ENDIF 664 485 665 CONTAINS 486 666 -
LMDZ6/trunk/libf/phylmd/regr_pr_time_av_m.F90
r3141 r3435 118 118 USE assert_m, ONLY: assert 119 119 USE assert_eq_m, ONLY: assert_eq 120 USE comvert_mod, ONLY: scaleheight120 !! USE comvert_mod, ONLY: scaleheight 121 121 USE interpolation, ONLY: locate 122 122 USE regr_conserv_m, ONLY: regr_conserv 123 123 USE regr_lint_m, ONLY: regr_lint 124 124 USE slopes_m, ONLY: slopes 125 USE mod_phys_lmdz_ mpi_data, ONLY: is_mpi_root126 USE mod_grid_phy_lmdz, ONLY: nlon=>nbp_lon, nlat=>nbp_lat, nlev_ou=>nbp_lev127 USE mod_phys_lmdz_transfert_para, ONLY: scatter2d, scatter 125 USE mod_phys_lmdz_para, ONLY: is_mpi_root,is_master 126 USE mod_grid_phy_lmdz, ONLY: nlon=>nbp_lon, nlat=>nbp_lat, nlev_ou=>nbp_lev, klon_glo, grid_type, unstructured 127 USE mod_phys_lmdz_transfert_para, ONLY: scatter2d, scatter, gather 128 128 USE phys_cal_mod, ONLY: calend, year_len, days_elapsed, jH_cur 129 USE geometry_mod, ONLY: ind_cell_glo 129 130 !------------------------------------------------------------------------------- 130 131 ! Arguments: … … 175 176 v2i(klon,SIZE(Pre_in)-1,SIZE(nam)), & !--- v2 in Ploc=='I' case 176 177 v2c(klon,SIZE(Pre_in) ,SIZE(nam)) !--- v2 in Ploc=='C' case 178 INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:) 177 179 LOGICAL :: ll 178 180 !--- For debug … … 255 257 CALL bcast(lO3Tfile); CALL bcast(linterp) 256 258 END IF 259 260 IF (is_master) THEN 261 ALLOCATE(ind_cell_glo_glo(klon_glo)) 262 ELSE 263 ALLOCATE(ind_cell_glo_glo(0)) 264 ENDIF 265 CALL gather(ind_cell_glo,ind_cell_glo_glo) 266 IF (is_master .AND. grid_type==unstructured) v1(:,:,:,:)=v1(:,ind_cell_glo_glo(:),:,:) 267 257 268 CALL scatter2d(v1,v2) 258 IF(lPrSfile) CALL scatter2d(pg1,Pgnd_in) 259 IF(lPrTfile) CALL scatter2d(pt1,Ptrp_in) 260 IF(lO3Tfile) CALL scatter2d(ot1,Otrp_in) 269 270 !--- No "ps" in input file => assumed to be equal to current LMDZ ground press 271 IF(lPrSfile) THEN 272 IF (is_master .AND. grid_type==unstructured) pg1(:,:)=pg1(:,ind_cell_glo_glo(:)) 273 CALL scatter2d(pg1,Pgnd_in) 274 ELSE 275 Pgnd_in=Pre_ou(:,1) 276 END IF 277 278 IF(lPrTfile) THEN 279 IF (is_master .AND. grid_type==unstructured) pt1(:,:)=pt1(:,ind_cell_glo_glo(:)) 280 CALL scatter2d(pt1,Ptrp_in) 281 ENDIF 282 283 IF(lO3Tfile) THEN 284 IF (is_master .AND. grid_type==unstructured) ot1(:,:)=ot1(:,ind_cell_glo_glo(:)) 285 CALL scatter2d(ot1,Otrp_in) 286 ENDIF 261 287 !--- No ground pressure in input file => choose it to be the one of LMDZ 262 288 IF(lAdjTro.AND..NOT.lPrSfile) Pgnd_in(:)=Pgrnd_ou(:) 263 264 !------------------------------------------------------------------------------- 265 IF(.NOT.lAdjTro) THEN !--- REGRID IN PRESSURE ; NO TROPOPAUSE ADJUSTMENT 266 !------------------------------------------------------------------------------- 289 290 !--- REGRID IN PRESSURE ; 3rd index inverted because "paprs" is decreasing 291 IF(.NOT.lAdjTro) THEN 267 292 DO i=1,klon 268 293 Pres_ou=Pre_ou(i,SIZE(Pre_ou,2):1:-1) !--- pplay & paprs are decreasing -
LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90
r2744 r3435 2 2 ! $Id: readaerosolstrato1_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $ 3 3 ! 4 4 5 SUBROUTINE readaerosolstrato1_rrtm(debut) 5 6 … … 9 10 10 11 USE phys_cal_mod, ONLY : mth_cur 11 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo 12 USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root 13 USE mod_phys_lmdz_omp_data, ONLY : is_omp_root 12 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured 14 13 USE mod_phys_lmdz_para 15 14 USE phys_state_var_mod … … 19 18 USE YOERAD, ONLY : NLW 20 19 USE YOMCST 20 USE xios 21 21 22 22 IMPLICIT NONE … … 45 45 REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :) 46 46 REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :) 47 REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :) 47 48 48 49 ! For NetCDF: … … 102 103 n_lat = size(latitude) 103 104 print *, 'LAT aerosol strato=', n_lat, latitude 104 IF (n_lat.NE.nbp_lat) THEN 105 print *,'Le nombre de lat n est pas egal a nbp_lat' 106 STOP 107 ENDIF 108 105 106 IF (grid_type/=unstructured) THEN 107 IF (n_lat.NE.nbp_lat) THEN 108 print *,'Le nombre de lat n est pas egal a nbp_lat' 109 STOP 110 ENDIF 111 ENDIF 112 109 113 CALL nf95_inq_varid(ncid_in, "LON", varid) 110 114 CALL nf95_gw_var(ncid_in, varid, longitude) 111 115 n_lon = size(longitude) 112 116 print *, 'LON aerosol strato=', n_lon, longitude 113 IF (n_lon.NE.nbp_lon) THEN 114 print *,'Le nombre de lon n est pas egal a nbp_lon' 115 STOP 116 ENDIF 117 117 118 IF (grid_type/=unstructured) THEN 119 IF (n_lon.NE.nbp_lon) THEN 120 print *,'Le nombre de lon n est pas egal a nbp_lon' 121 STOP 122 ENDIF 123 ENDIF 124 125 118 126 CALL nf95_inq_varid(ncid_in, "TIME", varid) 119 127 CALL nf95_gw_var(ncid_in, varid, time) … … 144 152 !---reduce to a klon_glo grid 145 153 CALL grid2dTo1d_glo(tauaerstrat_mois,tauaerstrat_mois_glo) 146 154 155 ELSE 156 ALLOCATE(tauaerstrat_mois(0,0,0)) 147 157 ENDIF !--is_mpi_root and is_omp_root 148 158 … … 153 163 154 164 !--scatter on all proc 155 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 156 165 166 IF (grid_type==unstructured) THEN 167 IF (is_omp_master) THEN 168 ALLOCATE(tauaerstrat_mpi(klon_mpi,klev)) 169 CALL xios_send_field("taustrat_in",tauaerstrat_mois) 170 CALL xios_recv_field("taustrat_out",tauaerstrat_mpi) 171 ELSE 172 ALLOCATE(tauaerstrat_mpi(0,0)) 173 ENDIF 174 CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat) 175 ELSE 176 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 177 ENDIF 178 157 179 IF (is_mpi_root.AND.is_omp_root) THEN 158 180 ! -
LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90
r2744 r3435 2 2 ! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $ 3 3 ! 4 4 5 SUBROUTINE readaerosolstrato2_rrtm(debut) 5 6 … … 9 10 10 11 USE phys_cal_mod, ONLY : mth_cur 11 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo 12 USE mod_phys_lmdz_mpi_data , ONLY : is_mpi_root13 USE mod_phys_lmdz_omp_data , ONLY : is_omp_root12 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured 13 USE mod_phys_lmdz_mpi_data 14 USE mod_phys_lmdz_omp_data 14 15 USE mod_phys_lmdz_para 15 16 USE phys_state_var_mod … … 19 20 USE YOERAD, ONLY : NLW 20 21 USE YOMCST 21 22 USE xios 22 23 IMPLICIT NONE 23 24 … … 65 66 REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :) 66 67 REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :) 68 REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :, :) 69 REAL, ALLOCATABLE:: pizaerstrat_mpi(:, :, :) 70 REAL, ALLOCATABLE:: cgaerstrat_mpi(:, :, :) 71 REAL, ALLOCATABLE:: taulwaerstrat_mpi(:, :, :) 67 72 68 73 ! For NetCDF: … … 107 112 CALL nf95_gw_var(ncid_in, varid, latitude) 108 113 n_lat = size(latitude) 109 IF (n_lat.NE.nbp_lat) THEN 110 print *, 'latitude=', n_lat, nbp_lat 111 abort_message='Le nombre de lat n est pas egal a nbp_lat' 112 CALL abort_physic(modname,abort_message,1) 114 115 IF (grid_type/=unstructured) THEN 116 IF (n_lat.NE.nbp_lat) THEN 117 print *, 'latitude=', n_lat, nbp_lat 118 abort_message='Le nombre de lat n est pas egal a nbp_lat' 119 CALL abort_physic(modname,abort_message,1) 120 ENDIF 113 121 ENDIF 114 122 … … 134 142 ALLOCATE(cgaerstrat(n_lat, n_lev, n_wav, n_month)) 135 143 136 ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav))137 ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav))138 ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav))139 140 ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav))141 ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav))142 ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav))143 144 144 !--reading stratospheric aerosol tau per layer 145 145 CALL nf95_inq_varid(ncid_in, "TAU_SUN", varid) … … 159 159 CALL nf95_close(ncid_in) 160 160 161 162 IF (grid_type/=unstructured) THEN 163 ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 164 ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 165 ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 166 167 ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 168 ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 169 ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 161 170 !--select the correct month 162 171 !--and copy into 1st longitude 163 tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur)164 pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur)165 cgaerstrat_mois(1,:,:,:) = cgaerstrat(:,:,:,mth_cur)172 tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur) 173 pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur) 174 cgaerstrat_mois(1,:,:,:) = cgaerstrat(:,:,:,mth_cur) 166 175 167 176 !--copy longitudes 168 DO i=2, n_lon169 tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:)170 pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:)171 cgaerstrat_mois(i,:,:,:) = cgaerstrat_mois(1,:,:,:)172 ENDDO177 DO i=2, n_lon 178 tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:) 179 pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:) 180 cgaerstrat_mois(i,:,:,:) = cgaerstrat_mois(1,:,:,:) 181 ENDDO 173 182 174 183 !---reduce to a klon_glo grid 175 DO band=1, NSW176 CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band))177 CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band))178 CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band))179 ENDDO180 184 DO band=1, NSW 185 CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band)) 186 CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band)) 187 CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band)) 188 ENDDO 189 ENDIF 181 190 !--Now LW optical properties 182 191 ! 192 183 193 CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in) 184 194 … … 194 204 CALL nf95_gw_var(ncid_in, varid, latitude) 195 205 n_lat = size(latitude) 196 IF (n_lat.NE.nbp_lat) THEN 197 abort_message='Le nombre de lat n est pas egal a nbp_lat' 198 CALL abort_physic(modname,abort_message,1) 199 ENDIF 200 206 207 IF (grid_type/=unstructured) THEN 208 IF (n_lat.NE.nbp_lat) THEN 209 abort_message='Le nombre de lat n est pas egal a nbp_lat' 210 CALL abort_physic(modname,abort_message,1) 211 ENDIF 212 ENDIF 213 201 214 CALL nf95_inq_varid(ncid_in, "TIME", varid) 202 215 CALL nf95_gw_var(ncid_in, varid, time) … … 217 230 218 231 ALLOCATE(taulwaerstrat(n_lat, n_lev, n_wav, n_month)) 219 ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav))220 ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav))221 232 222 233 !--reading stratospheric aerosol lw tau per layer … … 227 238 CALL nf95_close(ncid_in) 228 239 240 IF (grid_type/=unstructured) THEN 241 242 ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) 243 ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav)) 244 229 245 !--select the correct month 230 246 !--and copy into 1st longitude 231 taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur)247 taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur) 232 248 !--copy longitudes 233 DO i=2, n_lon234 taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:)235 ENDDO249 DO i=2, n_lon 250 taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:) 251 ENDDO 236 252 237 253 !---reduce to a klon_glo grid 238 DO band=1, NLW 239 CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band)) 240 ENDDO 241 254 DO band=1, NLW 255 CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band)) 256 ENDDO 257 ENDIF 258 242 259 ELSE !--proc other than mpi_root and omp_root 243 260 !--dummy allocation needed for debug mode … … 248 265 ALLOCATE(taulwaerstrat_mois_glo(1,1,1)) 249 266 267 ALLOCATE(tauaerstrat(0,0,0,12)) 268 ALLOCATE(pizaerstrat(0,0,0,12)) 269 ALLOCATE(cgaerstrat(0,0,0,12)) 270 ALLOCATE(taulwaerstrat(0,0,0,12)) 271 272 250 273 ENDIF !--is_mpi_root and is_omp_root 251 274 … … 255 278 mth_pre=mth_cur 256 279 280 IF (grid_type==unstructured) THEN 281 282 IF (is_omp_master) THEN 283 ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW)) 284 ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW)) 285 ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW)) 286 ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW)) 287 288 CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8)) 289 CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi) 290 CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8)) 291 CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi) 292 CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8)) 293 CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi) 294 CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8)) 295 CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi) 296 ELSE 297 ALLOCATE(tauaerstrat_mpi(0, 0, 0)) 298 ALLOCATE(pizaerstrat_mpi(0, 0, 0)) 299 ALLOCATE(cgaerstrat_mpi(0, 0, 0)) 300 ALLOCATE(taulwaerstrat_mpi(0, 0, 0)) 301 ENDIF 302 303 CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat) 304 CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat) 305 CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat) 306 CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat) 307 ELSE 308 257 309 !--scatter on all proc 258 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 259 CALL scatter(pizaerstrat_mois_glo,piz_aer_strat) 260 CALL scatter(cgaerstrat_mois_glo,cg_aer_strat) 261 CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat) 310 CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) 311 CALL scatter(pizaerstrat_mois_glo,piz_aer_strat) 312 CALL scatter(cgaerstrat_mois_glo,cg_aer_strat) 313 CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat) 314 315 ENDIF 262 316 263 317 IF (is_mpi_root.AND.is_omp_root) THEN 264 !265 DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat)266 318 DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois) 267 DEALLOCATE(taulwaerstrat,taulwaerstrat_mois) 268 ! 269 ENDIF !--is_mpi_root and is_omp_root 270 271 DEALLOCATE(tauaerstrat_mois_glo,pizaerstrat_mois_glo,cgaerstrat_mois_glo) 272 DEALLOCATE(taulwaerstrat_mois_glo) 319 DEALLOCATE(taulwaerstrat_mois) 320 DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat) 321 ENDIF 322 273 323 274 324 !$OMP BARRIER -
LMDZ6/trunk/libf/phylmd/rrtm/suinit.F90
r1990 r3435 126 126 ALLOCATE(VDELA (MAX(JPMXLE,NFLEVG))) 127 127 ALLOCATE(VDELB (MAX(JPMXLE,NFLEVG))) 128 VDELB = 0 !ym missing init 128 129 ALLOCATE( VC (NFLEVG) ) 130 VC = 0 !ym missing init 129 131 ALLOCATE( NLOEN (NPROMA) ) 130 132 ALLOCATE( NLOENG (NPROMA) ) -
LMDZ6/trunk/libf/phylmd/slab_heat_transp_mod.F90
r3002 r3435 83 83 cu_,cuvsurcv_,cv_,cvusurcu_, & 84 84 aire_,apoln_,apols_, & 85 aireu_,airev_,rlatv) 86 USE comconst_mod, ONLY: omeg, rad 85 aireu_,airev_,rlatv, rad, omeg) 87 86 ! number of points in lon, lat 88 87 IMPLICIT NONE … … 104 103 REAL,INTENT(IN) :: airev_(ip1jm) 105 104 REAL,INTENT(IN) :: rlatv(nbp_lat-1) 105 REAL,INTENT(IN) :: rad 106 REAL,INTENT(IN) :: omeg 106 107 107 108 ! Sanity check on dimensions -
LMDZ6/trunk/libf/phylmd/surf_land_mod.F90
r3391 r3435 41 41 USE surf_land_orchidee_nofrein_mod 42 42 #else 43 #if ORCHIDEE_NOUNSTRUCT 44 ! Compilation with cpp key ORCHIDEE_NOUNSTRUCT 45 USE surf_land_orchidee_nounstruct_mod 46 #else 43 47 USE surf_land_orchidee_mod 48 #endif 44 49 #endif 45 50 #endif -
LMDZ6/trunk/libf/phylmd/surf_land_orchidee_mod.F90
r3391 r3435 4 4 #ifndef ORCHIDEE_NOZ0H 5 5 #ifndef ORCHIDEE_NOFREIN 6 #ifndef ORCHIDEE_NOUNSTRUCT 6 7 ! 7 8 ! This module controles the interface towards the model ORCHIDEE. … … 23 24 USE cpl_mod, ONLY : cpl_send_land_fields 24 25 USE surface_data, ONLY : type_ocean 25 USE geometry_mod, ONLY : dx, dy 26 USE geometry_mod, ONLY : dx, dy, boundslon, boundslat,longitude, latitude, cell_area, ind_cell_glo 26 27 USE mod_grid_phy_lmdz 27 28 USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master 28 29 USE carbon_cycle_mod, ONLY : nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out 29 30 USE nrtype, ONLY : PI 31 30 32 IMPLICIT NONE 31 33 … … 165 167 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo 166 168 !$OMP THREADPRIVATE(lalo) 169 ! boundaries of cells 170 REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: bounds_lalo 171 !$OMP THREADPRIVATE(bounds_lalo) 167 172 ! pts voisins 168 173 INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours … … 178 183 !$OMP THREADPRIVATE(lon_scat,lat_scat) 179 184 185 ! area of cells 186 REAL, ALLOCATABLE, DIMENSION (:), SAVE :: area 187 !$OMP THREADPRIVATE(area) 188 180 189 LOGICAL, SAVE :: lrestart_read = .TRUE. 181 190 !$OMP THREADPRIVATE(lrestart_read) … … 209 218 !$OMP THREADPRIVATE(riverflow) 210 219 220 INTEGER :: orch_mpi_rank 221 INTEGER :: orch_mpi_size 211 222 INTEGER :: orch_omp_rank 212 223 INTEGER :: orch_omp_size 224 225 REAL, ALLOCATABLE, DIMENSION(:) :: longitude_glo 226 REAL, ALLOCATABLE, DIMENSION(:) :: latitude_glo 227 REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslon_glo 228 REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslat_glo 229 INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo 230 INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell 231 !$OMP THREADPRIVATE(ind_cell) 232 INTEGER :: begin, end 213 233 ! 214 234 ! Fin definition … … 253 273 jg(klon) = nbp_lat 254 274 255 IF ((.NOT. ALLOCATED( lalo))) THEN256 ALLOCATE( lalo(knon,2), stat = error)275 IF ((.NOT. ALLOCATED(area))) THEN 276 ALLOCATE(area(knon), stat = error) 257 277 IF (error /= 0) THEN 278 abort_message='Pb allocation area' 279 CALL abort_physic(modname,abort_message,1) 280 ENDIF 281 ENDIF 282 DO igrid = 1, knon 283 area(igrid) = cell_area(knindex(igrid)) 284 ENDDO 285 286 IF (grid_type==unstructured) THEN 287 288 289 IF ((.NOT. ALLOCATED(lon_scat))) THEN 290 ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) 291 IF (error /= 0) THEN 292 abort_message='Pb allocation lon_scat' 293 CALL abort_physic(modname,abort_message,1) 294 ENDIF 295 ENDIF 296 297 IF ((.NOT. ALLOCATED(lat_scat))) THEN 298 ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) 299 IF (error /= 0) THEN 300 abort_message='Pb allocation lat_scat' 301 CALL abort_physic(modname,abort_message,1) 302 ENDIF 303 ENDIF 304 CALL Gather(rlon,rlon_g) 305 CALL Gather(rlat,rlat_g) 306 307 IF (is_mpi_root) THEN 308 index = 1 309 DO jj = 2, nbp_lat-1 310 DO ij = 1, nbp_lon 311 index = index + 1 312 lon_scat(ij,jj) = rlon_g(index) 313 lat_scat(ij,jj) = rlat_g(index) 314 ENDDO 315 ENDDO 316 lon_scat(:,1) = lon_scat(:,2) 317 lat_scat(:,1) = rlat_g(1) 318 lon_scat(:,nbp_lat) = lon_scat(:,2) 319 lat_scat(:,nbp_lat) = rlat_g(klon_glo) 320 ENDIF 321 322 CALL bcast(lon_scat) 323 CALL bcast(lat_scat) 324 325 ELSE IF (grid_type==regular_lonlat) THEN 326 327 IF ((.NOT. ALLOCATED(lalo))) THEN 328 ALLOCATE(lalo(knon,2), stat = error) 329 IF (error /= 0) THEN 330 abort_message='Pb allocation lalo' 331 CALL abort_physic(modname,abort_message,1) 332 ENDIF 333 ENDIF 334 335 IF ((.NOT. ALLOCATED(bounds_lalo))) THEN 336 ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error) 337 IF (error /= 0) THEN 258 338 abort_message='Pb allocation lalo' 259 339 CALL abort_physic(modname,abort_message,1) 260 ENDIF 261 ENDIF 262 IF ((.NOT. ALLOCATED(lon_scat))) THEN 263 ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) 264 IF (error /= 0) THEN 265 abort_message='Pb allocation lon_scat' 266 CALL abort_physic(modname,abort_message,1) 267 ENDIF 268 ENDIF 269 IF ((.NOT. ALLOCATED(lat_scat))) THEN 270 ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) 271 IF (error /= 0) THEN 272 abort_message='Pb allocation lat_scat' 273 CALL abort_physic(modname,abort_message,1) 274 ENDIF 275 ENDIF 276 lon_scat = 0. 277 lat_scat = 0. 278 DO igrid = 1, knon 279 index = knindex(igrid) 280 lalo(igrid,2) = rlon(index) 281 lalo(igrid,1) = rlat(index) 282 ENDDO 283 284 285 286 CALL Gather(rlon,rlon_g) 287 CALL Gather(rlat,rlat_g) 288 289 IF (is_mpi_root) THEN 290 index = 1 291 DO jj = 2, nbp_lat-1 292 DO ij = 1, nbp_lon 293 index = index + 1 294 lon_scat(ij,jj) = rlon_g(index) 295 lat_scat(ij,jj) = rlat_g(index) 296 ENDDO 297 ENDDO 298 lon_scat(:,1) = lon_scat(:,2) 299 lat_scat(:,1) = rlat_g(1) 300 lon_scat(:,nbp_lat) = lon_scat(:,2) 301 lat_scat(:,nbp_lat) = rlat_g(klon_glo) 302 ENDIF 340 ENDIF 341 ENDIF 342 343 IF ((.NOT. ALLOCATED(lon_scat))) THEN 344 ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error) 345 IF (error /= 0) THEN 346 abort_message='Pb allocation lon_scat' 347 CALL abort_physic(modname,abort_message,1) 348 ENDIF 349 ENDIF 350 IF ((.NOT. ALLOCATED(lat_scat))) THEN 351 ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error) 352 IF (error /= 0) THEN 353 abort_message='Pb allocation lat_scat' 354 CALL abort_physic(modname,abort_message,1) 355 ENDIF 356 ENDIF 357 lon_scat = 0. 358 lat_scat = 0. 359 DO igrid = 1, knon 360 index = knindex(igrid) 361 lalo(igrid,2) = rlon(index) 362 lalo(igrid,1) = rlat(index) 363 bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI 364 bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI 365 ENDDO 366 367 368 369 CALL Gather(rlon,rlon_g) 370 CALL Gather(rlat,rlat_g) 371 372 IF (is_mpi_root) THEN 373 index = 1 374 DO jj = 2, nbp_lat-1 375 DO ij = 1, nbp_lon 376 index = index + 1 377 lon_scat(ij,jj) = rlon_g(index) 378 lat_scat(ij,jj) = rlat_g(index) 379 ENDDO 380 ENDDO 381 lon_scat(:,1) = lon_scat(:,2) 382 lat_scat(:,1) = rlat_g(1) 383 lon_scat(:,nbp_lat) = lon_scat(:,2) 384 lat_scat(:,nbp_lat) = rlat_g(klon_glo) 385 ENDIF 303 386 304 CALL bcast(lon_scat) 305 CALL bcast(lat_scat) 387 CALL bcast(lon_scat) 388 CALL bcast(lat_scat) 389 390 ENDIF 306 391 ! 307 392 ! Allouer et initialiser le tableau des voisins et des fraction de continents 308 393 ! 309 IF ( (.NOT.ALLOCATED(neighbours))) THEN310 ALLOCATE(neighbours(knon,8), stat = error)311 IF (error /= 0) THEN312 abort_message='Pb allocation neighbours'313 CALL abort_physic(modname,abort_message,1)314 ENDIF315 ENDIF316 neighbours = -1.317 394 IF (( .NOT. ALLOCATED(contfrac))) THEN 318 395 ALLOCATE(contfrac(knon), stat = error) … … 329 406 330 407 331 CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter)) 408 IF (grid_type==regular_lonlat) THEN 409 410 IF ( (.NOT.ALLOCATED(neighbours))) THEN 411 ALLOCATE(neighbours(knon,8), stat = error) 412 IF (error /= 0) THEN 413 abort_message='Pb allocation neighbours' 414 CALL abort_physic(modname,abort_message,1) 415 ENDIF 416 ENDIF 417 neighbours = -1. 418 CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter)) 419 420 ELSE IF (grid_type==unstructured) THEN 421 422 IF ( (.NOT.ALLOCATED(neighbours))) THEN 423 ALLOCATE(neighbours(knon,12), stat = error) 424 IF (error /= 0) THEN 425 abort_message='Pb allocation neighbours' 426 CALL abort_physic(modname,abort_message,1) 427 ENDIF 428 ENDIF 429 neighbours = -1. 430 431 ENDIF 432 332 433 333 434 ! … … 340 441 ENDIF 341 442 ENDIF 342 DO igrid = 1, knon 343 ij = knindex(igrid) 344 resolution(igrid,1) = dx(ij) 345 resolution(igrid,2) = dy(ij) 346 ENDDO 347 443 444 IF (grid_type==regular_lonlat) THEN 445 DO igrid = 1, knon 446 ij = knindex(igrid) 447 resolution(igrid,1) = dx(ij) 448 resolution(igrid,2) = dy(ij) 449 ENDDO 450 ENDIF 451 348 452 ALLOCATE(coastalflow(klon), stat = error) 349 453 IF (error /= 0) THEN … … 397 501 IF (debut) THEN 398 502 CALL Init_orchidee_index(knon,knindex,offset,ktindex) 399 CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank) 503 CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank) 504 505 IF (grid_type==unstructured) THEN 506 IF (knon==0) THEN 507 begin=1 508 end=0 509 ELSE 510 begin=offset+1 511 end=offset+ktindex(knon) 512 ENDIF 513 514 IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat 515 516 ALLOCATE(lalo(end-begin+1,2)) 517 ALLOCATE(bounds_lalo(end-begin+1,nvertex,2)) 518 ALLOCATE(ind_cell(end-begin+1)) 519 520 ALLOCATE(longitude_glo(klon_glo)) 521 CALL gather(longitude,longitude_glo) 522 CALL bcast(longitude_glo) 523 lalo(:,2)=longitude_glo(begin:end)*180./PI 524 525 ALLOCATE(latitude_glo(klon_glo)) 526 CALL gather(latitude,latitude_glo) 527 CALL bcast(latitude_glo) 528 lalo(:,1)=latitude_glo(begin:end)*180./PI 529 530 ALLOCATE(boundslon_glo(klon_glo,nvertex)) 531 CALL gather(boundslon,boundslon_glo) 532 CALL bcast(boundslon_glo) 533 bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI 534 535 ALLOCATE(boundslat_glo(klon_glo,nvertex)) 536 CALL gather(boundslat,boundslat_glo) 537 CALL bcast(boundslat_glo) 538 bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI 539 540 ALLOCATE(ind_cell_glo_glo(klon_glo)) 541 CALL gather(ind_cell_glo,ind_cell_glo_glo) 542 CALL bcast(ind_cell_glo_glo) 543 ind_cell(:)=ind_cell_glo_glo(begin:end) 544 545 ENDIF 400 546 CALL Init_synchro_omp 401 547 402 548 IF (knon > 0) THEN 403 549 #ifdef CPP_VEGET 404 CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm )550 CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm,grid=grid_type) 405 551 #endif 406 552 ENDIF 407 553 408 554 409 IF (knon > 0) THEN 555 IF (knon > 0) THEN 410 556 411 557 print *,'OB before intersurf=', SIZE(cfname_in), SIZE(cfname_out) 412 558 #ifdef CPP_VEGET 559 413 560 CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, & 414 561 lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, & … … 418 565 evap, fluxsens, fluxlat, coastalflow, riverflow, & 419 566 tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, & 420 ! >> PC 421 !lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch) 422 lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch, & 567 lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon), nvm_orch, & 568 grid=grid_type, bounds_latlon=bounds_lalo, cell_area=area, ind_cell_glo=ind_cell, & 423 569 field_out_names=cfname_out, field_in_names=cfname_in(1:nbcf_in_orc)) 424 ! << PC425 570 #endif 426 571 ENDIF … … 450 595 evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), & 451 596 tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), & 452 lon_scat, lat_scat, q2m , t2m, z0h_new(1:knon),&597 lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon),& 453 598 veget(1:knon,:),lai(1:knon,:),height(1:knon,:),& 454 599 fields_out=yfields_out(1:knon,1:nbcf_out), & … … 542 687 ! 543 688 544 SUBROUTINE Get_orchidee_communicator(orch_comm, orch_omp_size,orch_omp_rank)689 SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank) 545 690 USE mod_surf_para 546 691 … … 550 695 551 696 INTEGER,INTENT(OUT) :: orch_comm 697 INTEGER,INTENT(OUT) :: orch_mpi_size 698 INTEGER,INTENT(OUT) :: orch_mpi_rank 552 699 INTEGER,INTENT(OUT) :: orch_omp_size 553 700 INTEGER,INTENT(OUT) :: orch_omp_rank … … 568 715 #ifdef CPP_MPI 569 716 CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr) 717 CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr) 718 CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr) 570 719 #endif 571 720 … … 696 845 #endif 697 846 #endif 847 #endif 698 848 END MODULE surf_land_orchidee_mod -
LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90
r3421 r3435 10 10 11 11 USE dimphy 12 USE infotrac 12 USE infotrac_phy 13 13 USE geometry_mod, ONLY : cell_area 14 14 USE carbon_cycle_mod, ONLY : nbcf_in, fields_in, cfname_in, fco2_ocn_day, fco2_ff, fco2_bb … … 119 119 120 120 USE dimphy 121 USE infotrac 121 USE infotrac_phy 122 122 USE geometry_mod, ONLY : cell_area 123 123 USE mod_grid_phy_lmdz -
LMDZ6/trunk/libf/phylmd/undefSTD.F90
r2346 r3435 43 43 ! PARAMETER(klevSTD=17) 44 44 INTEGER itap 45 ! REAL dtime46 45 47 46 ! variables locales … … 67 66 68 67 69 ! calcul variables tous les freq_calNMC(n)/ dtimepas de temps68 ! calcul variables tous les freq_calNMC(n)/phys_tstep pas de temps 70 69 ! de la physique 71 70 72 IF (mod(itap,nint(freq_calnmc(n)/ dtime))==0) THEN71 IF (mod(itap,nint(freq_calnmc(n)/phys_tstep))==0) THEN 73 72 DO k = 1, nlevstd 74 73 DO i = 1, klon … … 103 102 END DO !k 104 103 105 END IF !MOD(itap,NINT(freq_calNMC(n)/ dtime)).EQ.0104 END IF !MOD(itap,NINT(freq_calNMC(n)/phys_tstep)).EQ.0 106 105 107 106 END DO !n -
LMDZ6/trunk/libf/phylmd/write_histrac.h
r2265 r3435 8 8 9 9 CALL histwrite_phy(nid_tra,.FALSE.,"phis",itau_w,pphis) 10 CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w, airephy)10 CALL histwrite_phy(nid_tra,.FALSE.,"aire",itau_w,cell_area) 11 11 CALL histwrite_phy(nid_tra,.FALSE.,"zmasse",itau_w,zmasse) 12 12 ! RomP >>> -
LMDZ6/trunk/libf/phylmd/yamada4.F90
r3041 r3435 734 734 IMPLICIT NONE 735 735 736 include "dimensions.h"737 738 736 ! vdif_q2: subroutine qui calcule la diffusion de la TKE par la TKE 739 737 ! avec un schema implicite en temps avec … … 825 823 IMPLICIT NONE 826 824 827 include "dimensions.h"828 !829 825 ! vdif_q2e: subroutine qui calcule la diffusion de TKE par la TKE 830 826 ! avec un schema explicite en temps -
LMDZ6/trunk/makelmdz
r3359 r3435 112 112 [-v false/orchidee2.0/orchidee1.9/true] : version of the vegetation model to include (default: false) 113 113 false : no vegetation model 114 orchidee2.1 : compile using ORCHIDEE 2.1 (or more recent version) 114 115 orchidee2.0 : compile using ORCHIDEE 2.0 (or more recent version) 115 116 orchidee1.9 : compile using ORCHIDEE up to the version including OpenMP in ORCHIDEE : tag 1.9-1.9.5(version AR5)-1.9.6 … … 432 433 433 434 #============================================================================== 434 if [ "$veget" = "true" -o "$veget" = "orchidee1.9" -o "$veget" = "orchidee2.0" ]435 if [ "$veget" = "true" -o "$veget" = "orchidee1.9" -o "$veget" = "orchidee2.0" -o "$veget" = "orchidee2.1" ] 435 436 then 436 437 … … 442 443 fi 443 444 if [[ "$veget" == "orchidee2.0" ]] ; then 445 orch_libs="sechiba parameters stomate parallel orglob orchidee" 446 CPP_KEY="$CPP_KEY ORCHIDEE_NOUNSTRUCT" 447 elif [[ "$veget" == "orchidee2.1" ]] ; then 444 448 orch_libs="sechiba parameters stomate parallel orglob orchidee" 445 449 else -
LMDZ6/trunk/makelmdz_fcm
r3358 r3435 90 90 [-v false/orchidee2.0/orchidee1.9/true] : version of the vegetation model to include (default: false) 91 91 false : no vegetation model 92 orchidee2.0 : compile using ORCHIDEE 2.0 (or more recent version) 92 orchidee2.1 : compile using ORCHIDEE 2.1 (or more recent version) 93 orchidee2.0 : compile using ORCHIDEE 2.0 93 94 orchidee1.9 : compile using ORCHIDEE up to the version including OpenMP in ORCHIDEE : tag 1.9-1.9.5(version AR5)-1.9.6 94 95 true : (obsolete; for backward compatibility) use ORCHIDEE tag 1.9-1.9.6 … … 373 374 fi 374 375 375 if [ "$veget" = "true" -o "$veget" = "orchidee1.9" -o "$veget" = "orchidee2.0" ]376 if [ "$veget" = "true" -o "$veget" = "orchidee1.9" -o "$veget" = "orchidee2.0" -o "$veget" = "orchidee2.1" ] 376 377 then 377 378 #NB: option 'true': for backward compatibility. To be used with ORCHIDEE tag 1.9-1.9.6 … … 385 386 fi 386 387 if [[ "$veget" == "orchidee2.0" ]] ; then 388 orch_libs="sechiba parameters stomate parallel orglob orchidee" 389 CPP_KEY="$CPP_KEY ORCHIDEE_NOUNSTRUCT" 390 elif [[ "$veget" == "orchidee2.1" ]] ; then 387 391 orch_libs="sechiba parameters stomate parallel orglob orchidee" 388 392 else -
LMDZ6/trunk/tools/fcm/lib/Fcm/CfgFile.pm
r1578 r3435 19 19 # Standard pragma 20 20 use warnings; 21 no warnings 'uninitialized'; 21 22 use strict; 22 23
Note: See TracChangeset
for help on using the changeset viewer.