Index: /trunk/LMDZ.MARS/changelog.txt =================================================================== --- /trunk/LMDZ.MARS/changelog.txt (revision 4059) +++ /trunk/LMDZ.MARS/changelog.txt (revision 4060) @@ -5065,2 +5065,11 @@ == 10/02/2026 == JBC Deletion of 'qsurf' in the information provided by "start1D.txt" since it is unused and unnecessary until now. Addition of an error-leading check to prevent an unintended situation (which should not happen) regarding the presence of starting files. + +== 10/02/2026 == EM +Some code cleanup: +- remove obsolete "eofdump" routine and related "calleofdump" flag +- remove obsolete "callg2d" flag +- rename vague and non-descriptive "linear" flag as "lwxn_linear" (as + it is only used in lwxn routine), likewise rename "alphan" "lwxn_alphan" + and "ncouche" "lwxn_ncouche" + And move these 3 flags from callkeys_mod to the lwxn module Index: /trunk/LMDZ.MARS/libf/phymars/callkeys_mod.F90 =================================================================== --- /trunk/LMDZ.MARS/libf/phymars/callkeys_mod.F90 (revision 4059) +++ /trunk/LMDZ.MARS/libf/phymars/callkeys_mod.F90 (revision 4060) @@ -10,6 +10,4 @@ logical,save :: season,diurnal,calllott,calllott_nonoro !$OMP THREADPRIVATE(season,diurnal,calllott,calllott_nonoro) -logical,save :: calleofdump -!$OMP THREADPRIVATE(calleofdump) logical,save :: callnirco2,callnlte,callthermos,callconduct !$OMP THREADPRIVATE(callnirco2,callnlte,callthermos,callconduct) @@ -21,8 +19,5 @@ !$OMP THREADPRIVATE(callyamada4,callatke) logical,save :: callemis -logical,save :: callg2d -!$OMP THREADPRIVATE(callemis,callg2d) -logical,save :: linear ! ?!? -!$OMP THREADPRIVATE(linear) +!$OMP THREADPRIVATE(callemis) logical,save :: gwd_convective_source !$OMP THREADPRIVATE(gwd_convective_source) @@ -30,6 +25,4 @@ real,save :: semi ! ?!? !$OMP THREADPRIVATE(semi) -real,save :: alphan ! ?!? -!$OMP THREADPRIVATE(alphan) real,save :: fixed_euv_value !$OMP THREADPRIVATE(fixed_euv_value) @@ -56,6 +49,4 @@ integer,save :: ilwn !$OMP THREADPRIVATE(ilwd,ilwb,ilwn) -integer,save :: ncouche -!$OMP THREADPRIVATE(ncouche) integer,save :: solvarmod ! model for solar EUV variation !$OMP THREADPRIVATE(solvarmod) Index: /trunk/LMDZ.MARS/libf/phymars/conf_phys.F =================================================================== --- /trunk/LMDZ.MARS/libf/phymars/conf_phys.F (revision 4059) +++ /trunk/LMDZ.MARS/libf/phymars/conf_phys.F (revision 4060) @@ -46,8 +46,9 @@ & ads_massive_ice use nonoro_gwd_mix_mod, only: calljliu_gwimix + use lwxn_mod, only: lwxn_linear, lwxn_alphan, lwxn_ncouche use callkeys_mod, only: startphy_file, activice, activeco2ice, - & alphan, calladj, callatke, callcond, + & calladj, callatke, callcond, & callconduct, calldifv, callemis, - & calleofdump, calleuv, callg2d, calllott, + & calleuv, calllott, & calllott_nonoro, callmoldiff, callmolvis, & callnirco2, callnlte, callrad, callrichsl, @@ -61,6 +62,7 @@ & euveff, fixed_euv_value, hdo, hdofrac, & iaervar, ilwb, ilwd, ilwn, iradia, - & linear, latentheat_surfwater, microphys, - & meteo_flux, ncouche, nircorr, nltemodel, + & latentheat_surfwater, microphys, + & meteo_flux, + & nircorr, nltemodel, & photochem, poreice_tifeedback, rayleigh, & rdstorm, refill_watercap, satindexco2, @@ -87,4 +89,6 @@ real :: albedo_perennialco2_north, albedo_perennialco2_south + logical :: callg2d ! obsolete unused flag... (but could be read from radia.def ?) + CHARACTER ch1*12 #ifndef MESOSCALE @@ -187,15 +191,10 @@ write(*,*) " diagsoil = ",diagsoil - write(*,*) "Save EOF profiles in file 'profiles' for ", - & "Climate Database?" - calleofdump=.false. ! default value - call getin_p("calleofdump",calleofdump) - write(*,*) " calleofdump = ",calleofdump - write(*,*) "Dust scenario: 1=constant dust (read from startfi", & " or set as tauvis); 2=Viking scenario; =3 MGS scenario,", & "=6 cold (low dust) scenario; =7 warm (high dust) scenario ", - & "=24,25 ... 30 :Mars Year 24, ... or 30 from TES assimilation" - iaervar=3 ! default value + & "=8 climatology scenario (our best guess of a standard Mars)", + & "=24,25 ... 36,37 : Mars Year 24, ... 37 from observed dust" + iaervar=8 ! default value call getin_p("iaervar",iaervar) write(*,*) " iaervar = ",iaervar @@ -418,10 +417,4 @@ write(*,*)" iradia = ",iradia - - write(*,*)"Output of the exchange coefficient mattrix ?", - & "(for diagnostics only)" - callg2d=.false. ! default value - call getin_p("callg2d",callg2d) - write(*,*)" callg2d = ",callg2d write(*,*)"Rayleigh scattering : (should be .false. for now)" @@ -1300,7 +1293,7 @@ ilwn=1 !2 ilwb=1 !2 - linear=.true. - ncouche=3 - alphan=0.4 + lwxn_linear=.true. + lwxn_ncouche=3 + lwxn_alphan=0.4 semi=0 @@ -1329,14 +1322,14 @@ READ(99,fmt='(a)') ch1 - READ(99,*) linear - WRITE(*,8000) ch1,linear + READ(99,*) lwxn_linear + WRITE(*,8000) ch1,lwxn_linear READ(99,fmt='(a)') ch1 - READ(99,*) ncouche - WRITE(*,8001) ch1,ncouche + READ(99,*) lwxn_ncouche + WRITE(*,8001) ch1,lwxn_ncouche READ(99,fmt='(a)') ch1 - READ(99,*) alphan - WRITE(*,*) ch1,alphan + READ(99,*) lwxn_alphan + WRITE(*,*) ch1,lwxn_alphan READ(99,fmt='(a)') ch1 @@ -1361,7 +1354,7 @@ call bcast(ilwd) call bcast(ilwn) - call bcast(linear) - call bcast(ncouche) - call bcast(alphan) + call bcast(lwxn_linear) + call bcast(lwxn_ncouche) + call bcast(lwxn_alphan) call bcast(ilwb) call bcast(callg2d) Index: unk/LMDZ.MARS/libf/phymars/eofdump_mod.F90 =================================================================== --- /trunk/LMDZ.MARS/libf/phymars/eofdump_mod.F90 (revision 4059) +++ (revision ) @@ -1,154 +1,0 @@ -module eofdump_mod -! this module controls the production of data for EOFs -! it won't work if run in parallel (but it's OK, we don't use it anymore...) -! Mainly kept for reference. -implicit none -! Dump profiles for EOFs every ieofs physics timesteps, -! starting at first call; -integer :: ieofs -! Dump profiles every eofskip points in each direction -! on the model grid. -integer, parameter :: eofskip = 4 -! Units for writing EOF header and data: -integer, parameter :: uehead = 82, uedata = 83 - -contains - - subroutine eofdump(ngrid,nlayer,u,v,t,rho,ps) - - use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat - implicit none -! -! Dumps profiles for calculation of variability EOFs -! Modified to include rho, FF 09/2004 -! Corrected small bug in sampling rate/count, EM 11/2007 -! -! - - integer,intent(in) :: ngrid ! total number of physics grid points - integer,intent(in) :: nlayer ! number of atmospheric layers - real,intent(in) :: u(ngrid,nlayer) - real,intent(in) :: v(ngrid,nlayer) - real,intent(in) :: t(ngrid,nlayer) - real,intent(in) :: rho(ngrid,nlayer) - real,intent(in) :: ps(ngrid) - integer,save :: count=0 - integer i,j,l, ig - - LOGICAL,SAVE :: firstcall=.true. - -!$OMP THREADPRIVATE(count,firstcall) - -!------------------------------------------------------- -! Initialization at first call: -! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - IF (firstcall) THEN - write(*,*) 'CALL ineofdump' - CALL ineofdump(ngrid,nlayer) - firstcall=.false. - END IF - -!------------------------------------------------------- -! Dumps every ieofs physics timesteps -! -! write(*,*)'eofdump:count=',count,' ps(1)=',ps(1) -! if ((ieofs.gt.0).and.(mod(count,ieofs).eq.0)) then - if (mod(count+1,ieofs).eq.0) then -! write(*,*)'eofdump: dump --> ps(1)=',ps(1) - do i=1,nbp_lon,eofskip - do j=1+eofskip/2,nbp_lat,eofskip - ig = 1+ (j-2)*nbp_lon +i -#ifdef NC_DOUBLE - write(uedata) (real(u(ig,l)),l=1,nlayer) - write(uedata) (real(v(ig,l)),l=1,nlayer) - write(uedata) (real(t(ig,l)),l=1,nlayer) - write(uedata) (real(rho(ig,l)),l=1,nlayer) - write(uedata) real(ps(ig)) -#else - write(uedata) (u(ig,l),l=1,nlayer) - write(uedata) (v(ig,l),l=1,nlayer) - write(uedata) (t(ig,l),l=1,nlayer) - write(uedata) (rho(ig,l),l=1,nlayer) - write(uedata) ps(ig) -#endif - enddo - enddo - endif - count=count+1 - - end subroutine eofdump - - - subroutine ineofdump(ngrid,nlayer) - - use geometry_mod, only: longitude, latitude - use nrtype, only: pi - use time_phylmdz_mod, only: daysec, dtphys - USE vertical_layers_mod, ONLY: aps,bps - use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat - implicit none -! -! Initialise dumping of profiles for EOF calculations -! - - integer,intent(in) :: ngrid ! total number of physics grid points - integer,intent(in) :: nlayer ! number of atmospheric layers - integer ig,i,j,l - logical,save :: firstcall=.true. - integer,save :: npgrid - -!$OMP THREADPRIVATE(firstcall,npgrid) - - - if (firstcall) then - npgrid=ngrid+2*(nbp_lon-1) - firstcall=.false. - endif - -! -! Set frequency for dumping at once per day -! - ieofs=nint(daysec/dtphys) - if (abs(float(ieofs)-daysec/dtphys).gt.1.e-8*daysec) then - call abort_physic("ineofdump",' 1 day .ne. n physics timesteps',1) - endif -! -! Header -! - open(uehead,file='profiles.hdr',form='formatted') - write(uehead,*) 0.E+0,0,0,ieofs,1,0 - write(uehead,*) nbp_lon,npgrid/nbp_lon,npgrid,nlayer - - do i=1,nbp_lon,eofskip - do j=1+eofskip/2,nbp_lat,eofskip - ig = 1+ (j-2)*nbp_lon +i - if(j.eq.1) then - call abort_physic("ineofdump",'Error: j==1',1) - endif - if(j.eq.nbp_lat) then - call abort_physic("ineofdump",'Error: j==nbp_lat',1) - endif -#ifdef NC_DOUBLE - write(uehead,*) real(longitude(ig)*180./pi),real(latitude(ig)*180./pi) -#else - write(uehead,*) longitude(ig)*180./pi, latitude(ig)*180./pi -#endif -! write(*,*) 'eof grid j=',j,' lat= ', latitude(ig)*180./pi - enddo - enddo - -#ifdef NC_DOUBLE - write(uehead,*) real(aps) - write(uehead,*) real(bps) -#else - write(uehead,*) aps - write(uehead,*) bps -#endif - close(uehead) -! -! Main profile file -! - open(uedata,file='profiles.dat',form='unformatted') - end subroutine ineofdump - -end module eofdump_mod Index: /trunk/LMDZ.MARS/libf/phymars/lwxn.F =================================================================== --- /trunk/LMDZ.MARS/libf/phymars/lwxn.F (revision 4059) +++ /trunk/LMDZ.MARS/libf/phymars/lwxn.F (revision 4060) @@ -2,4 +2,12 @@ implicit none + + logical,save :: lwxn_linear +!$OMP THREADPRIVATE(lwxn_linear) + real,save :: lwxn_alphan +!$OMP THREADPRIVATE(lwxn_alphan) + integer,save :: lwxn_ncouche +!$OMP THREADPRIVATE(lwxn_ncouche) + contains @@ -53,7 +61,7 @@ c sublayer 3 c ----------------------------- nj=4 -c sublayer ncouche -c *********************************************************** ni=nj=ncouche+1 -c sublayer ncouche +c sublayer lwxn_ncouche +c *********************************************************** ni=nj=lwxn_ncouche+1 +c sublayer lwxn_ncouche c ----------------------------- ni=4 c sublayer 3 @@ -78,5 +86,4 @@ use dimradmars_mod, only: ndlo2, nuco2, ndlon, nflev use yomlw_h, only: nlaylte, xi, xi_ground, xi_emis - use callkeys_mod, only: linear, alphan, ncouche use lwtt_mod, only: lwtt implicit none @@ -135,5 +142,5 @@ c -------------- - jk=ncouche+1 + jk=lwxn_ncouche+1 do ja = 1 ,nuco2 do jl = 1 , kdlon @@ -147,9 +154,9 @@ enddo - if (linear) then - - do nlmd = 1 ,ncouche - cn(nlmd)=(1.0/ncouche) - cb(nlmd)=(ncouche-nlmd+0.5)/ncouche + if (lwxn_linear) then + + do nlmd = 1 ,lwxn_ncouche + cn(nlmd)=(1.0/lwxn_ncouche) + cb(nlmd)=(lwxn_ncouche-nlmd+0.5)/lwxn_ncouche c print*,nlmd,cb(nlmd),cn(nlmd) enddo @@ -157,18 +164,18 @@ else - do nlmd = 1 ,ncouche-1 - cn(nlmd)=(1-alphan)*alphan**(nlmd-1) - cb(nlmd)=0.5*(1+alphan)*alphan**(nlmd-1) - enddo - cn(ncouche)=alphan**(ncouche-1) - cb(ncouche)=0.5*alphan**(ncouche-1) + do nlmd = 1 ,lwxn_ncouche-1 + cn(nlmd)=(1-lwxn_alphan)*lwxn_alphan**(nlmd-1) + cb(nlmd)=0.5*(1+lwxn_alphan)*lwxn_alphan**(nlmd-1) + enddo + cn(lwxn_ncouche)=lwxn_alphan**(lwxn_ncouche-1) + cb(lwxn_ncouche)=0.5*lwxn_alphan**(lwxn_ncouche-1) endif c test - if (nmax .LT. ncouche) then + if (nmax .LT. lwxn_ncouche) then print*,'!!!!! ATTENTION !!!!! ' print*,'probleme dans lwxn.F' - print*,' nmax=',nmax,' < ncouche=',ncouche + print*,' nmax=',nmax,' < lwxn_ncouche=',lwxn_ncouche call exit(1) endif @@ -190,5 +197,5 @@ . / aer_t(jl,ja,jk+1) - do nlmd=1,ncouche + do nlmd=1,lwxn_ncouche zu_i(jl,ja,nlmd)=cn(nlmd)*zu_layer_i(jl,ja) zup_i(jl,ja,nlmd)=cn(nlmd)*zup_layer_i(jl,ja) @@ -203,5 +210,5 @@ . / aer_t(jl,ja,jk+2) - do nlmd=1,ncouche + do nlmd=1,lwxn_ncouche zu_j(jl,ja,nlmd)=cn(nlmd)*zu_layer_j(jl,ja) zup_j(jl,ja,nlmd)=cn(nlmd)*zup_layer_j(jl,ja) @@ -216,5 +223,5 @@ c ------------------------------------ - do ni = 1 ,ncouche+1 + do ni = 1 ,lwxn_ncouche+1 do ja = 1 ,nuco2 @@ -224,5 +231,5 @@ zt_aer(jl,ja)=1. - do nlmd=ni,ncouche+1 + do nlmd=ni,lwxn_ncouche+1 zu(jl,ja)=zu(jl,ja)+zu_i(jl,ja,nlmd) zup(jl,ja)=zup(jl,ja)+zup_i(jl,ja,nlmd) @@ -236,5 +243,5 @@ do ja = 1 ,nuco2 do jl = 1 , kdlon - trans(jl,ja,ni,ncouche+1)=zt_co2(jl,ja)*zt_aer(jl,ja) + trans(jl,ja,ni,lwxn_ncouche+1)=zt_co2(jl,ja)*zt_aer(jl,ja) enddo enddo @@ -260,5 +267,5 @@ ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - do nj = 1 ,ncouche+1 + do nj = 1 ,lwxn_ncouche+1 do ja = 1 ,nuco2 @@ -268,5 +275,5 @@ zt_aer(jl,ja)=1. - do nlmd=nj,ncouche+1 + do nlmd=nj,lwxn_ncouche+1 zu(jl,ja)=zu(jl,ja)+zu_j(jl,ja,nlmd) zup(jl,ja)=zup(jl,ja)+zup_j(jl,ja,nlmd) @@ -280,5 +287,5 @@ do ja = 1 ,nuco2 do jl = 1 , kdlon - trans(jl,ja,ncouche+1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja) + trans(jl,ja,lwxn_ncouche+1,nj)=zt_co2(jl,ja)*zt_aer(jl,ja) enddo enddo @@ -313,11 +320,11 @@ enddo - do ni = 1 ,ncouche + do ni = 1 ,lwxn_ncouche do ja = 1 ,nuco2 do jl = 1 , kdlon ksi(jl,ja,jk)=ksi(jl,ja,jk) + - . ( trans(jl,ja,ni+1,ncouche+1) - . - trans(jl,ja,ni,ncouche+1) + . ( trans(jl,ja,ni+1,lwxn_ncouche+1) + . - trans(jl,ja,ni,lwxn_ncouche+1) . - trans(jl,ja,ni+1,1) . + trans(jl,ja,ni,1) ) @@ -329,12 +336,12 @@ enddo - do nj = 1 ,ncouche + do nj = 1 ,lwxn_ncouche do ja = 1 ,nuco2 do jl = 1 , kdlon ksi(jl,ja,jk)=ksi(jl,ja,jk) + - . ( trans(jl,ja,ncouche+1,nj+1) + . ( trans(jl,ja,lwxn_ncouche+1,nj+1) . - trans(jl,ja,1,nj+1) - . - trans(jl,ja,ncouche+1,nj) + . - trans(jl,ja,lwxn_ncouche+1,nj) . + trans(jl,ja,1,nj) ) . * (cb(nj)*dp(jl,jk+1)) * 2 @@ -369,11 +376,11 @@ enddo - do ni = 1 ,ncouche + do ni = 1 ,lwxn_ncouche do ja = 1 ,nuco2 do jl = 1 , kdlon xi_ground(ig0+jl,ja) = xi_ground(ig0+jl,ja) - . + ( trans(jl,ja,ni+1,ncouche+1) - . -trans(jl,ja,ni,ncouche+1)) + . + ( trans(jl,ja,ni+1,lwxn_ncouche+1) + . -trans(jl,ja,ni,lwxn_ncouche+1)) . * 2 * cb(ni) enddo Index: /trunk/LMDZ.MARS/libf/phymars/physiq_mod.F =================================================================== --- /trunk/LMDZ.MARS/libf/phymars/physiq_mod.F (revision 4059) +++ /trunk/LMDZ.MARS/libf/phymars/physiq_mod.F (revision 4060) @@ -109,5 +109,4 @@ use phyetat0_mod, only: phyetat0, tab_cntrl_mod use wstats_mod, only: callstats, wstats, mkstats - use eofdump_mod, only: eofdump USE vertical_layers_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt USE mod_phys_lmdz_omp_data, ONLY: is_omp_master @@ -137,5 +136,5 @@ use callkeys_mod, only: calladj, calltherm, callatke, calldifv use callkeys_mod, only: callrichsl, tke_heat_flux - use callkeys_mod, only: calllott, calllott_nonoro, calleofdump + use callkeys_mod, only: calllott, calllott_nonoro use callkeys_mod, only: callrad, callnlte, callnirco2, nircorr use callkeys_mod, only: diurnal, season, iradia, nltemodel @@ -190,5 +189,4 @@ c - "startfi", "histfi" (if it's time) c - Saving statistics (if "callstats = .true.") -c - Dumping eof (if "calleofdump = .true.") c - Output any needed variables in "diagfi" c 11. Diagnostic: mass conservation of tracers @@ -3195,8 +3193,4 @@ ENDIF -c (Store EOF for Mars Climate database software) - IF (calleofdump) THEN - CALL eofdump(ngrid, nlayer, zu, zv, zt, rho, ps) - ENDIF #endif !endif of ifndef MESOSCALE