Changeset 3501
- Timestamp:
- Nov 8, 2024, 10:56:39 AM (4 weeks ago)
- Location:
- trunk/LMDZ.PLUTO/libf/phypluto
- Files:
-
- 4 edited
-
callcorrk_pluto_mod.F90 (modified) (2 diffs)
-
physiq_mod.F90 (modified) (8 diffs)
-
suaer_corrk.F90 (modified) (2 diffs)
-
xios_output_mod.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.PLUTO/libf/phypluto/callcorrk_pluto_mod.F90
r3444 r3501 240 240 if (aerohaze) then 241 241 242 print*,'aerohaze: starting suaer_corrk' 243 call suaer_corrk ! set up aerosol optical properties 244 print*,'ending suaer_corrk' 242 ! AF24: TODO check duplicate suaer_corrk called from physiq_mod 243 ! print*,'aerohaze: starting suaer_corrk' 244 ! call suaer_corrk ! set up aerosol optical properties 245 ! print*,'ending suaer_corrk' 245 246 246 247 !-------------------------------------------------- … … 256 257 end do !iaer=1,naerkind. 257 258 if (haze_radproffix) then 258 if (haze_radproffix) then 259 call haze_reffrad_fix(ngrid,nlayer,zzlay, & 260 reffrad,nueffrad) 261 endif 259 call haze_reffrad_fix(ngrid,nlayer,zzlay, & 260 reffrad,nueffrad) 262 261 print*, 'haze_radproffix=T : fixed profile for haze rad' 263 262 else -
trunk/LMDZ.PLUTO/libf/phypluto/physiq_mod.F90
r3500 r3501 2103 2103 ENDDO 2104 2104 ENDIF 2105 2106 2107 2105 endif 2106 2107 if (carbox) then 2108 2108 IF (fast) then 2109 2109 DO ig=1,ngrid … … 2122 2122 ENDDO 2123 2123 ENDIF 2124 2125 2126 2127 2128 2129 DO ig=1,ngrid2130 DO l=1,nlayer2131 2132 2133 2124 endif 2125 2126 zrho_haze(:,:)=0. 2127 zdqrho_photprec(:,:)=0. 2128 IF (haze.and.aerohaze) then 2129 DO ig=1,ngrid 2130 DO l=1,nlayer 2131 zrho_haze(ig,l)=zq(ig,l,igcm_haze)*rho(ig,l) 2132 zdqrho_photprec(ig,l)=zdqphot_prec(ig,l)*rho(ig,l) 2133 ENDDO 2134 2134 ENDDO 2135 2135 ENDIF 2136 2136 2137 2138 DO ig=1,ngrid2139 qcol(ig,igcm_haze)=zq(ig,1,igcm_haze)*pplev(ig,1)/g2140 qcol(ig,igcm_prec_haze)=zq(ig,1,igcm_prec_haze)*pplev(ig,1)/g2141 ENDDO2142 2137 IF (fasthaze) then 2138 DO ig=1,ngrid 2139 qcol(ig,igcm_haze)=zq(ig,1,igcm_haze)*pplev(ig,1)/g 2140 qcol(ig,igcm_prec_haze)=zq(ig,1,igcm_prec_haze)*pplev(ig,1)/g 2141 ENDDO 2142 ENDIF 2143 2143 2144 2144 ! Info about Ls, declin... 2145 2145 IF (fast) THEN 2146 2146 if (is_master) write(*,*),'Ls=',zls*180./pi,' dec=',declin*180./pi 2147 2147 if (is_master) write(*,*),'zday=',zday,' ps=',globave 2148 IF (lastcall) then2149 if (is_master) write(*,*),'lastcall'2150 ENDIF2151 2148 IF (lastcall) then 2149 if (is_master) write(*,*),'lastcall' 2150 ENDIF 2151 ELSE 2152 2152 if (is_master) write(*,*),'Ls=',zls*180./pi,'decli=',declin*180./pi,'zday=',zday 2153 ENDIF 2154 2155 lecttsoil=0 ! default value for lecttsoil 2156 call getin_p("lecttsoil",lecttsoil) 2157 IF (lastcall.and.(ngrid.EQ.1).and.(lecttsoil.eq.1)) THEN 2158 ! save tsoil temperature profile for 1D profile 2159 OPEN(13,file='proftsoil.out',form='formatted') 2160 DO i=1,nsoilmx 2161 write(13,*) tsoil(1,i) 2162 ENDDO 2163 CLOSE(13) 2164 ENDIF 2165 2153 ENDIF 2154 2155 lecttsoil=0 ! default value for lecttsoil 2156 call getin_p("lecttsoil",lecttsoil) 2157 IF (lastcall.and.(ngrid.EQ.1).and.(lecttsoil.eq.1)) THEN 2158 ! save tsoil temperature profile for 1D profile 2159 OPEN(13,file='proftsoil.out',form='formatted') 2160 DO i=1,nsoilmx 2161 write(13,*) tsoil(1,i) 2162 ENDDO 2163 CLOSE(13) 2164 ENDIF 2166 2165 2167 2166 if (is_master) print*,'--> Ls =',zls*180./pi 2168 2169 2170 !----------------------------------------------------------------------2171 ! Writing NetCDF file "RESTARTFI" at the end of the run2172 !----------------------------------------------------------------------2173 2174 ! Note: 'restartfi' is stored just before dynamics are stored2175 ! in 'restart'. Between now and the writting of 'restart',2176 ! there will have been the itau=itau+1 instruction and2177 ! a reset of 'time' (lastacll = .true. when itau+1= itaufin)2178 ! thus we store for time=time+dtvr2179 2180 2181 2167 2182 2168 if(lastcall) then … … 2230 2216 ! Finally ensure conservation of qsurf 2231 2217 DO iq=1,nq 2232 call globalaverage2d(ngrid,qsurf(:,iq),globaveice(iq))2233 call globalaverage2d(ngrid,qsurfpal(:,iq), &2218 call globalaverage2d(ngrid,qsurf(:,iq),globaveice(iq)) 2219 call globalaverage2d(ngrid,qsurfpal(:,iq), & 2234 2220 globavenewice(iq)) 2235 IF (globavenewice(iq).gt.0.) THEN2236 qsurfpal(:,iq)=qsurfpal(:,iq)* &2221 IF (globavenewice(iq).gt.0.) THEN 2222 qsurfpal(:,iq)=qsurfpal(:,iq)* & 2237 2223 globaveice(iq)/globavenewice(iq) 2238 ENDIF2224 ENDIF 2239 2225 ENDDO 2240 2226 … … 2243 2229 !phisfipal(ig)=phisfi(ig) 2244 2230 2245 2246 2231 if (kbo.or.triton) then ! case of Triton : we do not change the orbital parameters 2247 2248 pdaypal=pday ! no increment of pdaypal to keep same evolution of the subsolar point 2249 eccpal=1.-periastr/((periastr+apoastr)/2.) !no change of ecc 2250 peri_daypal=peri_day ! no change 2251 oblipal=obliquit ! no change 2252 tpalnew=tpal 2253 adjustnew=adjust 2232 pdaypal=pday ! no increment of pdaypal to keep same evolution of the subsolar point 2233 eccpal=1.-periastr/((periastr+apoastr)/2.) !no change of ecc 2234 peri_daypal=peri_day ! no change 2235 oblipal=obliquit ! no change 2236 tpalnew=tpal 2237 adjustnew=adjust 2254 2238 2255 2239 else ! Pluto 2256 ! update new pday and tpal (Myr) to be set in startfi controle 2257 pdaypal=int(day_ini+paleoyears*365.25/6.3872) 2258 tpalnew=tpal+paleoyears*1.e-6 ! Myrs 2259 2260 ! update new N2 ice adjustment (not tested yet on Pluto) 2261 adjustnew=adjust 2262 2263 ! update milankovitch parameters : obliquity,Lsp,ecc 2264 call calcmilank(tpalnew,oblipal,peri_daypal,eccpal) 2265 !peri_daypal=peri_day 2266 !eccpal=0.009 2267 2240 ! update new pday and tpal (Myr) to be set in startfi controle 2241 pdaypal=int(day_ini+paleoyears*365.25/6.3872) 2242 tpalnew=tpal+paleoyears*1.e-6 ! Myrs 2243 2244 ! update new N2 ice adjustment (not tested yet on Pluto) 2245 adjustnew=adjust 2246 2247 ! update milankovitch parameters : obliquity,Lsp,ecc 2248 call calcmilank(tpalnew,oblipal,peri_daypal,eccpal) 2249 !peri_daypal=peri_day 2250 !eccpal=0.009 2268 2251 endif 2269 2252 … … 2271 2254 if (is_master) write(*,*) "Paleo eccpal=",eccpal," tpal=",tpalnew 2272 2255 2256 !---------------------------------------------------------------------- 2257 ! Writing NetCDF file "RESTARTFI" at the end of the run 2258 !---------------------------------------------------------------------- 2259 ! Note: 'restartfi' is stored just before dynamics are stored 2260 ! in 'restart'. Between now and the writing of 'restart', 2261 ! there will have been the itau=itau+1 instruction and 2262 ! a reset of 'time' (lastacll = .true. when itau+1= itaufin) 2263 ! thus we store for time=time+dtvr 2273 2264 2274 2265 #ifndef MESOSCALE 2275 2266 ! create restartfi 2276 if (ngrid.ne.1) then 2277 !TODO: import this routine from pluto.old 2278 ! call physdem1pal("restartfi.nc",long,lati,nsoilmx,nq, & 2279 ! ptimestep,pdaypal, & 2280 ! ztime_fin,tsurf,tsoil,emis,q2,qsurfpal, & 2281 ! cell_area,albedodat,inertiedat,zmea,zstd,zsig, & 2282 ! zgam,zthe,oblipal,eccpal,tpalnew,adjustnew,phisfipal, & 2283 ! peri_daypal) 2284 endif 2285 else ! 'paleo' 2286 2287 if (ngrid.ne.1) then 2288 write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin 2289 2290 call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq, & 2291 ptimestep,ztime_fin, & 2292 tsurf,tsoil,emis,q2,qsurf_hist) 2293 endif 2267 if (ngrid.ne.1) then 2268 print*, "physdem1pal not yet implemented" 2269 stop 2270 !TODO: import this routine from pluto.old 2271 ! call physdem1pal("restartfi.nc",long,lati,nsoilmx,nq, & 2272 ! ptimestep,pdaypal, & 2273 ! ztime_fin,tsurf,tsoil,emis,q2,qsurfpal, & 2274 ! cell_area,albedodat,inertiedat,zmea,zstd,zsig, & 2275 ! zgam,zthe,oblipal,eccpal,tpalnew,adjustnew,phisfipal, & 2276 ! peri_daypal) 2277 endif 2278 else ! 'paleo' 2279 2280 if (ngrid.ne.1) then 2281 write(*,*)'PHYSIQ: for physdem ztime_fin =',ztime_fin 2282 2283 call physdem1("restartfi.nc",nsoilmx,ngrid,nlayer,nq, & 2284 ptimestep,ztime_fin, & 2285 tsurf,tsoil,emis,q2,qsurf_hist) 2286 endif 2294 2287 #endif 2295 endif ! end of 'paleo' 2296 ! if(ok_slab_ocean) then 2297 ! call ocean_slab_final!(tslab, seaice) 2298 ! end if 2299 2300 endif ! end of 'lastcall' 2288 endif ! end of 'paleo' 2289 endif ! end of 'lastcall' 2301 2290 2302 2291 … … 2309 2298 2310 2299 2311 call wstats(ngrid,"ps","Surface pressure","Pa",2,ps) 2312 call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf) 2313 call wstats(ngrid,"fluxsurf_lw", & 2314 "Thermal IR radiative flux to surface","W.m-2",2, & 2315 fluxsurf_lw) 2316 call wstats(ngrid,"fluxtop_lw", & 2317 "Thermal IR radiative flux to space","W.m-2",2, & 2318 fluxtop_lw) 2319 2320 ! call wstats(ngrid,"fluxsurf_sw", & 2321 ! "Solar radiative flux to surface","W.m-2",2, & 2322 ! fluxsurf_sw_tot) 2323 ! call wstats(ngrid,"fluxtop_sw", & 2324 ! "Solar radiative flux to space","W.m-2",2, & 2325 ! fluxtop_sw_tot) 2326 2327 2328 call wstats(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn) 2329 call wstats(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw) 2330 call wstats(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw) 2331 !call wstats(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent) 2332 !call wstats(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1)) 2333 call wstats(ngrid,"p","Pressure","Pa",3,pplay) 2334 call wstats(ngrid,"emis","Emissivity","",2,emis) 2335 call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt) 2336 call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu) 2337 call wstats(ngrid,"v","Meridional (North-South) wind","m.s-1",3,zv) 2338 call wstats(ngrid,"w","Vertical (down-up) wind","m.s-1",3,pw) 2339 call wstats(ngrid,"q2","Boundary layer eddy kinetic energy","m2.s-2",3,q2) 2340 2341 if (tracer) then 2342 do iq=1,nq 2343 call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) 2344 call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf', & 2345 'kg m^-2',2,qsurf(1,iq) ) 2346 call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 2347 'kg m^-2',2,qcol(1,iq) ) 2348 2349 ! call wstats(ngrid,trim(noms(iq))//'_reff', & 2350 ! trim(noms(iq))//'_reff', & 2351 ! 'm',3,reffrad(1,1,iq)) 2352 2353 end do 2354 2355 endif ! end of 'tracer' 2356 2357 !AF24: deleted slab ocean and water 2358 2359 if(lastcall.and.callstats) then 2360 write (*,*) "Writing stats..." 2361 call mkstats(ierr) 2362 endif 2363 2300 call wstats(ngrid,"ps","Surface pressure","Pa",2,ps) 2301 call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf) 2302 call wstats(ngrid,"fluxsurf_lw", & 2303 "Thermal IR radiative flux to surface","W.m-2",2, & 2304 fluxsurf_lw) 2305 call wstats(ngrid,"fluxtop_lw", & 2306 "Thermal IR radiative flux to space","W.m-2",2, & 2307 fluxtop_lw) 2308 2309 ! call wstats(ngrid,"fluxsurf_sw", & 2310 ! "Solar radiative flux to surface","W.m-2",2, & 2311 ! fluxsurf_sw_tot) 2312 ! call wstats(ngrid,"fluxtop_sw", & 2313 ! "Solar radiative flux to space","W.m-2",2, & 2314 ! fluxtop_sw_tot) 2315 2316 call wstats(ngrid,"ISR","incoming stellar rad.","W m-2",2,fluxtop_dn) 2317 call wstats(ngrid,"ASR","absorbed stellar rad.","W m-2",2,fluxabs_sw) 2318 call wstats(ngrid,"OLR","outgoing longwave rad.","W m-2",2,fluxtop_lw) 2319 ! call wstats(ngrid,"ALB","Surface albedo"," ",2,albedo_equivalent) 2320 ! call wstats(ngrid,"ALB_1st","First Band Surface albedo"," ",2,albedo(:,1)) 2321 call wstats(ngrid,"p","Pressure","Pa",3,pplay) 2322 call wstats(ngrid,"emis","Emissivity","",2,emis) 2323 call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt) 2324 call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu) 2325 call wstats(ngrid,"v","Meridional (North-South) wind","m.s-1",3,zv) 2326 call wstats(ngrid,"w","Vertical (down-up) wind","m.s-1",3,pw) 2327 call wstats(ngrid,"q2","Boundary layer eddy kinetic energy","m2.s-2",3,q2) 2328 2329 if (tracer) then 2330 do iq=1,nq 2331 call wstats(ngrid,noms(iq),noms(iq),'kg/kg',3,zq(1,1,iq)) 2332 call wstats(ngrid,trim(noms(iq))//'_surf',trim(noms(iq))//'_surf',& 2333 'kg m^-2',2,qsurf(1,iq) ) 2334 call wstats(ngrid,trim(noms(iq))//'_col',trim(noms(iq))//'_col', & 2335 'kg m^-2',2,qcol(1,iq) ) 2336 call wstats(ngrid,trim(noms(iq))//'_reff',trim(noms(iq))//'_reff',& 2337 'm',3,reffrad(1,1,iq)) 2338 end do 2339 2340 endif ! end of 'tracer' 2341 2342 if(lastcall.and.callstats) then 2343 write (*,*) "Writing stats..." 2344 call mkstats(ierr) 2345 endif 2364 2346 2365 2347 #ifndef MESOSCALE 2366 2348 2367 !----------------------------------------------------------------------------------------------------- 2368 ! OUTPUT in netcdf file "DIAGFI.NC", containing any variable for diagnostic 2349 !------------------------------------------------------------------------------ 2350 ! OUTPUT in netcdf file "DIAGFI.NC", 2351 ! containing any variable for diagnostic 2369 2352 ! 2370 2353 ! Note 1 : output with period "ecritphy", set in "run.def" 2371 ! 2372 ! Note 2 : writediagfi can also be called from any other subroutine for any variable,2373 ! but its preferable to keep all thecalls in one place ...2374 !------------------------------------------------------------------------------ -----------------------2354 ! Note 2 : writediagfi can also be called from any other subroutine 2355 ! for any variable, but its preferable to keep all the 2356 ! calls in one place ... 2357 !------------------------------------------------------------------------------ 2375 2358 2376 2359 call writediagfi(ngrid,"Ls","solar longitude","deg",0,zls*180./pi) … … 2454 2437 endif ! end of 'enertest' 2455 2438 2456 ! Diagnostics of optical thickness2457 ! Warning this is exp(-tau), I let you postproc with -log to have tau itself - JVO 192458 if (diagdtau) then2459 do nw=1,L_NSPECTV2460 write(str2,'(i2.2)') nw2461 call writediagfi(ngrid,'dtauv'//str2,'Layer optical thickness attenuation in VI band '//str2,'',1,int_dtauv(:,nlayer:1:-1,nw))2462 enddo2463 do nw=1,L_NSPECTI2464 write(str2,'(i2.2)') nw2465 call writediagfi(ngrid,'dtaui'//str2,'Layer optical thickness attenuation in IR band '//str2,'',1,int_dtaui(:,nlayer:1:-1,nw))2466 enddo2467 endif2468 2469 ! Temporary inclusions for heating diagnostics.2470 call writediagfi(ngrid,"zdtsw","SW heating","T s-1",3,zdtsw)2471 call writediagfi(ngrid,"zdtlw","LW heating","T s-1",3,zdtlw)2472 call writediagfi(ngrid,"dtrad","radiative heating","K s-1",3,dtrad)2473 call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn)2474 2475 ! For Debugging.2476 !call writediagfi(ngrid,'rnat','Terrain type',' ',2,real(rnat))2477 !call writediagfi(ngrid,'pphi','Geopotential',' ',3,pphi)2439 ! Diagnostics of optical thickness 2440 ! Warning this is exp(-tau), I let you postproc with -log to have tau itself - JVO 19 2441 if (diagdtau) then 2442 do nw=1,L_NSPECTV 2443 write(str2,'(i2.2)') nw 2444 call writediagfi(ngrid,'dtauv'//str2,'Layer optical thickness attenuation in VI band '//str2,'',1,int_dtauv(:,nlayer:1:-1,nw)) 2445 enddo 2446 do nw=1,L_NSPECTI 2447 write(str2,'(i2.2)') nw 2448 call writediagfi(ngrid,'dtaui'//str2,'Layer optical thickness attenuation in IR band '//str2,'',1,int_dtaui(:,nlayer:1:-1,nw)) 2449 enddo 2450 endif 2451 2452 ! Temporary inclusions for heating diagnostics. 2453 call writediagfi(ngrid,"zdtsw","SW heating","T s-1",3,zdtsw) 2454 call writediagfi(ngrid,"zdtlw","LW heating","T s-1",3,zdtlw) 2455 call writediagfi(ngrid,"dtrad","radiative heating","K s-1",3,dtrad) 2456 call writediagfi(ngrid,"zdtdyn","Dyn. heating","T s-1",3,zdtdyn) 2457 2458 ! For Debugging. 2459 !call writediagfi(ngrid,'rnat','Terrain type',' ',2,real(rnat)) 2460 !call writediagfi(ngrid,'pphi','Geopotential',' ',3,pphi) 2478 2461 2479 2462 ! Output tracers. … … 2525 2508 call writediagfi(ngrid,"zdqadj_ch4","zdqadj ch4","",& 2526 2509 3,zdqadj(:,:,igcm_ch4_gas)) 2527 2510 if (sedimentation) then 2528 2511 call writediagfi(ngrid,"zdqsed_ch4","zdqsed ch4","",& 2529 2512 3,zdqsed(:,:,igcm_ch4_gas)) 2530 2513 call writediagfi(ngrid,"zdqssed_ch4","zdqssed ch4","",& 2531 2514 2,zdqssed(:,igcm_ch4_gas)) 2532 2533 2515 endif 2516 if (metcloud.and.(.not.fast)) then 2534 2517 call writediagfi(ngrid,"zdtch4cloud","ch4 cloud","T s-1",& 2535 2518 3,zdtch4cloud) -
trunk/LMDZ.PLUTO/libf/phypluto/suaer_corrk.F90
r3377 r3501 131 131 allocate(file_id(naerkind,2)) 132 132 133 if (noaero) then 134 print*, 'naerkind= 0' 135 endif 133 ! if (noaero) then 134 ! print*, 'naerkind= 0' 135 ! naerkind=0 136 ! endif 136 137 137 138 … … 218 219 write(*,*)' http://www.lmd.jussieu.fr/',& 219 220 '~lmdz/planets/LMDZ.GENERIC/datagcm/' 220 CALL ABORT221 call abort_physic("suaer_corrk",'Problem with optical properties file',1) 221 222 ENDIF 222 223 -
trunk/LMDZ.PLUTO/libf/phypluto/xios_output_mod.F90
r3184 r3501 2 2 3 3 IMPLICIT NONE 4 4 5 5 INTEGER,PRIVATE,SAVE :: time_it=0 ! store number of iterations with calls to XIOS since start 6 6 ! does not need to be threadprivate; managed by omp master 7 7 8 8 CHARACTER(LEN=*), PARAMETER :: context_id= "LMDZ" ! same as in context_lmdz_physics.xml 9 9 10 10 #ifdef CPP_XIOS 11 11 … … 13 13 MODULE PROCEDURE histwrite0d_xios,histwrite2d_xios,histwrite3d_xios!,histwrite1d_xios 14 14 END INTERFACE 15 15 16 16 17 17 CONTAINS … … 36 36 USE wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_closedef 37 37 IMPLICIT NONE 38 38 39 39 REAL,INTENT(IN) :: day ! Number of elapsed sols since reference Ls=0. 40 40 REAL,INTENT(IN) :: timeofday ! "Universal time", given as fraction of sol (e.g.: 0.5 for noon). … … 46 46 REAL,INTENT(IN) :: wnoi(:) ! Array of wavenumbers at the spectral interval centers for the infrared. 47 47 real,intent(in) :: wnov (:) !Array of wavenumbers at the spectral interval centers for the visible. 48 48 49 49 INTEGER :: data_ibegin, data_iend 50 50 TYPE(xios_duration) :: timestep 51 51 TYPE(xios_date) :: time_origin 52 52 TYPE(xios_date) :: start_date 53 53 54 54 !$OMP BARRIER 55 55 !$OMP MASTER … … 74 74 ! IF (mpi_rank == 0) THEN 75 75 ! data_ibegin = 0 76 ! ELSE 76 ! ELSE 77 77 ! data_ibegin = ii_begin - 1 78 78 ! END IF … … 129 129 !NB: it would make more sense to define months and their length in the 130 130 ! xml files and not to have them hard coded here.... to be improved... 131 131 132 132 ! time origin of the simulation (default: 1st year/1st month/1st day, Ls=0) 133 133 time_origin=xios_date(1,1,1,0,0,0) … … 151 151 !$OMP END MASTER 152 152 !$OMP BARRIER 153 153 154 154 END SUBROUTINE initialize_xios_output 155 155 … … 159 159 USE xios 160 160 IMPLICIT NONE 161 !$OMP BARRIER 161 !$OMP BARRIER 162 162 !$OMP MASTER 163 163 CALL xios_context_finalize 164 !$OMP END MASTER 165 !$OMP BARRIER 166 164 !$OMP END MASTER 165 !$OMP BARRIER 166 167 167 END SUBROUTINE finalize_xios_output 168 168 … … 176 176 time_it=time_it+1 177 177 CALL xios_update_calendar(time_it) 178 !$OMP END MASTER 178 !$OMP END MASTER 179 179 END SUBROUTINE update_xios_timestep 180 180 … … 189 189 CALL xios_get_handle(context_id,ctx_hdl) 190 190 CALL xios_set_current_context(ctx_hdl) 191 !$OMP END MASTER 191 !$OMP END MASTER 192 192 END SUBROUTINE set_xios_context 193 193 … … 198 198 USE print_control_mod, ONLY: prt_level, lunout 199 199 IMPLICIT NONE 200 200 201 201 CHARACTER(LEN=*), INTENT(IN) :: field_name 202 202 REAL, INTENT(IN) :: field 203 203 204 204 IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite0d_xios ',trim(field_name) 205 205 206 206 !$OMP MASTER 207 207 CALL xios_send_field(field_name,field) 208 208 !$OMP END MASTER 209 209 210 210 IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite0d_xios ',trim(field_name) 211 211 212 212 END SUBROUTINE histwrite0d_xios 213 213 … … 226 226 CHARACTER(LEN=*), INTENT(IN) :: field_name 227 227 REAL, DIMENSION(:), INTENT(IN) :: field 228 228 229 229 REAL,DIMENSION(klon_mpi) :: buffer_omp 230 230 REAL :: Field2d(nbp_lon,jj_nb) 231 231 232 232 IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name) 233 if ((size(field) .eq. L_NSPECTI) .or. (size(field) .eq. L_NSPECTV)) then 234 !$OMP MASTER 233 if ((size(field) .eq. L_NSPECTI) .or. (size(field) .eq. L_NSPECTV)) then 234 !$OMP MASTER 235 235 ! only for spectral stuff: IR_Bandwidth and VI_Bandwidth 236 236 call xios_send_field(field_name,field) … … 239 239 endif 240 240 IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1) 241 242 CALL Gather_omp(field,buffer_omp) 241 242 CALL Gather_omp(field,buffer_omp) 243 243 !$OMP MASTER 244 244 CALL grid1Dto2D_mpi(buffer_omp,Field2d) 245 245 246 246 CALL xios_send_field(field_name, Field2d) 247 !$OMP END MASTER 247 !$OMP END MASTER 248 248 249 249 IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',trim(field_name) … … 281 281 282 282 CALL xios_send_field(field_name, Field3d(:,:,1:nlev)) 283 !$OMP END MASTER 283 !$OMP END MASTER 284 284 285 285 IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',trim(field_name)
Note: See TracChangeset
for help on using the changeset viewer.
