Index: trunk/LMDZ.MARS/changelog.txt =================================================================== --- trunk/LMDZ.MARS/changelog.txt (revision 3726) +++ trunk/LMDZ.MARS/changelog.txt (revision 3727) @@ -4798,2 +4798,6 @@ == 17/04/2025 == EM Turn "callkeys.h" into module "callkeys_mod.F90" + +== 17/04/2025 == EM +Code tidying: put routines in modules, remove useless "return" statements and +remove obsolete and unused scopyi.F Index: trunk/LMDZ.MARS/libf/phymars/callsedim_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/callsedim_mod.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/callsedim_mod.F (revision 3727) @@ -24,4 +24,5 @@ & nqfils,qperemin,masseqmin ! MVals: variables isotopes USE newsedim_mod, ONLY: newsedim + USE vlz_fi_mod, ONLY: vlz_fi USE comcstfi_h, ONLY: g USE dimradmars_mod, only: naerkind Index: trunk/LMDZ.MARS/libf/phymars/calltherm_interface.F90 =================================================================== --- trunk/LMDZ.MARS/libf/phymars/calltherm_interface.F90 (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/calltherm_interface.F90 (revision 3727) @@ -1,2 +1,7 @@ +MODULE calltherm_interface_mod + +IMPLICIT NONE + +CONTAINS !======================================================================= ! CALLTHERM_INTERFACE @@ -51,5 +56,9 @@ ! "r" : recuced gas constant (J.K-1.mol-1) ! "cpp" : specific heat of the atmosphere (J.kg-1.K-1) - USE comcstfi_h + USE comcstfi_h, only: r, g, cpp + + use thermcell_main_mars_mod, only: thermcell_main_mars + + use thermcell_dqup_mod, only: thermcell_dqup implicit none @@ -488,3 +497,5 @@ ENDDO - END + END SUBROUTINE calltherm_interface + +END MODULE calltherm_interface_mod Index: trunk/LMDZ.MARS/libf/phymars/newsedim_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/newsedim_mod.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/newsedim_mod.F (revision 3727) @@ -7,4 +7,5 @@ SUBROUTINE newsedim(ngrid,nlay,naersize,nrhosize,ptimestep, & pplev,masse,epaisseur,pt,rd,rho,pqi,wq,beta) + USE vlz_fi_mod, ONLY: vlz_fi USE comcstfi_h, ONLY: r,g IMPLICIT NONE Index: trunk/LMDZ.MARS/libf/phymars/phyetat0_mod.F90 =================================================================== --- trunk/LMDZ.MARS/libf/phymars/phyetat0_mod.F90 (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/phyetat0_mod.F90 (revision 3727) @@ -34,4 +34,5 @@ use comcstfi_h, only: pi use geometry_mod, only: latitude +use soil_settings_mod, only: soil_settings use callkeys_mod, only: startphy_file, rdstorm, hdo Index: trunk/LMDZ.MARS/libf/phymars/physiq_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/physiq_mod.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/physiq_mod.F (revision 3727) @@ -125,5 +125,7 @@ & ini_comslope_h use write_output_mod, only: write_output + use soil_mod, only: soil use pbl_parameters_mod, only: pbl_parameters + use calltherm_interface_mod, only: calltherm_interface use lmdz_atke_turbulence_ini, only : atke_ini use waterice_tifeedback_mod, only : waterice_tifeedback Index: trunk/LMDZ.MARS/libf/phymars/scopyi.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/scopyi.F (revision 3726) +++ (revision ) @@ -1,17 +1,0 @@ - subroutine scopyi(n,sx,incx,sy,incy) -c - IMPLICIT NONE -c - integer n,incx,incy,ix,iy,i - integer sx((n-1)*incx+1),sy((n-1)*incy+1) -c - iy=1 - ix=1 - do 10 i=1,n - sy(iy)=sx(ix) - ix=ix+incx - iy=iy+incy -10 continue -c - return - end Index: trunk/LMDZ.MARS/libf/phymars/soil.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/soil.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/soil.F (revision 3727) @@ -1,2 +1,8 @@ + module soil_mod + + implicit none + + contains + subroutine soil(ngrid,nsoil,firstcall, & therm_i, @@ -25,14 +31,14 @@ ! --------- ! inputs: - integer ngrid ! number of (horizontal) grid-points - integer nsoil ! number of soil layers - logical firstcall ! identifier for initialization call - real therm_i(ngrid,nsoil,nslope) ! thermal inertia - real timestep ! time step - real tsurf(ngrid,nslope) ! surface temperature + integer,intent(in) :: ngrid ! number of (horizontal) grid-points + integer,intent(in) :: nsoil ! number of soil layers + logical,intent(in) :: firstcall ! identifier for initialization call + real,intent(in) :: therm_i(ngrid,nsoil,nslope) ! thermal inertia + real,intent(in) :: timestep ! time step + real,intent(in) :: tsurf(ngrid,nslope) ! surface temperature ! outputs: - real tsoil(ngrid,nsoil,nslope) ! soil (mid-layer) temperature - real capcal(ngrid,nslope) ! surface specific heat - real fluxgrd(ngrid,nslope) ! surface diffusive heat flux + real,intent(out) :: tsoil(ngrid,nsoil,nslope) ! soil (mid-layer) temperature + real,intent(out) :: capcal(ngrid,nslope) ! surface specific heat + real,intent(out) :: fluxgrd(ngrid,nslope) ! surface diffusive heat flux ! local variables: @@ -200,4 +206,7 @@ enddo enddo ! islope - end - + + end subroutine soil + + end module soil_mod + Index: trunk/LMDZ.MARS/libf/phymars/soil_settings.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/soil_settings.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/soil_settings.F (revision 3727) @@ -1,2 +1,8 @@ + module soil_settings_mod + + implicit none + + contains + subroutine soil_settings(nid,ngrid,nsoil,nqsoil,tsurf,tsoil, & qsoil,indextime) @@ -516,3 +522,6 @@ write(*,*)'Soil temperature :',xmin,xmax - end + end subroutine soil_settings + + end module soil_settings_mod + Index: trunk/LMDZ.MARS/libf/phymars/swmain_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/swmain_mod.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/swmain_mod.F (revision 3727) @@ -15,4 +15,7 @@ use yomlw_h, only: nlaylte, gcp use callkeys_mod, only: swrtype + use swr_fouquart_mod, only: swr_fouquart + use swr_toon_mod, only: swr_toon + IMPLICIT NONE Index: trunk/LMDZ.MARS/libf/phymars/swr_fouquart.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/swr_fouquart.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/swr_fouquart.F (revision 3727) @@ -1,2 +1,8 @@ + MODULE swr_fouquart_mod + + IMPLICIT NONE + + CONTAINS + SUBROUTINE SWR_FOUQUART ( KDLON, KFLEV, KNU S , aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d @@ -367,6 +373,6 @@ C - RETURN - END + + END SUBROUTINE SWR_FOUQUART CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -524,5 +530,6 @@ C 131 CONTINUE - RETURN - END - + + END SUBROUTINE DEDD + + END MODULE swr_fouquart_mod Index: trunk/LMDZ.MARS/libf/phymars/swr_toon.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/swr_toon.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/swr_toon.F (revision 3727) @@ -1,2 +1,8 @@ + module swr_toon_mod + + implicit none + + contains + SUBROUTINE SWR_TOON ( KDLON, KFLEV, KNU S , aerosol,QVISsQREF3d,omegaVIS3d,gVIS3d @@ -206,6 +212,5 @@ c End part added by Tran The Trung - RETURN - END + END SUBROUTINE SWR_TOON CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -379,6 +384,5 @@ END DO - RETURN - END + END SUBROUTINE GFLUXV CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -388,13 +392,15 @@ C DOUBLE PRECISION VERSION OF SOLVER - + IMPLICIT NONE cc PARAMETER (NMAX=201) cc AS+JBM 03/2010 - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL), + INTEGER NL +! IMPLICIT REAL*8 (A-H,O-Z) + REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL), * XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL) + REAL*8 BTOP,BSURF,RSF cc AS+JBM 03/2010 cc DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX) - DIMENSION AF(2*NL),BF(2*NL),CF(2*NL),DF(2*NL),XK(2*NL) + REAL*8 AF(2*NL),BF(2*NL),CF(2*NL),DF(2*NL),XK(2*NL) C********************************************************* @@ -427,4 +433,6 @@ C======================================================================C + INTEGER :: I, L, LM1, LM2, N + L=2*NL @@ -484,6 +492,5 @@ 28 CONTINUE - RETURN - END + END SUBROUTINE DSOLVER CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -492,12 +499,15 @@ C DOUBLE PRECISION VERSION OF TRIDGL - + IMPLICIT NONE cc AS+JBM 03/2010 : OBSOLETE MAINTENANT cc PARAMETER (NMAX=201) - IMPLICIT REAL*8 (A-H,O-Z) - DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L) +! IMPLICIT REAL*8 (A-H,O-Z) + INTEGER L + REAL*8 AF(L),BF(L),CF(L),DF(L),XK(L) cc AS+JBM 03/2010 : OBSOLETE MAINTENANT cc DIMENSION AS(NMAX),DS(NMAX) - DIMENSION AS(L),DS(L) + REAL*8 AS(L),DS(L) + REAL*8 X + INTEGER I C* THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX @@ -523,5 +533,5 @@ END DO - RETURN - END - + END SUBROUTINE DTRIDGL + + end module swr_toon_mod Index: trunk/LMDZ.MARS/libf/phymars/thermcell_dqup.F90 =================================================================== --- trunk/LMDZ.MARS/libf/phymars/thermcell_dqup.F90 (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/thermcell_dqup.F90 (revision 3727) @@ -1,2 +1,8 @@ +MODULE thermcell_dqup_mod + +IMPLICIT NONE + +CONTAINS + !======================================================================= ! THERMCELL_DQUP @@ -99,5 +105,5 @@ ! ============== - return - end + end subroutine thermcell_dqup +END MODULE thermcell_dqup_mod Index: trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90 =================================================================== --- trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90 (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/thermcell_main_mars.F90 (revision 3727) @@ -1,2 +1,8 @@ +MODULE thermcell_main_mars_mod + +IMPLICIT NONE + +CONTAINS + !======================================================================= ! THERMCELL_MAIN_MARS @@ -49,6 +55,8 @@ ! "g" : gravitational acceleration (m.s-2) ! "r" : recuced gas constant (J.K-1.mol-1) - USE comcstfi_h - + USE comcstfi_h, only: g, r + + use thermcell_dqup_mod, only: thermcell_dqup + IMPLICIT NONE @@ -1245,4 +1253,5 @@ enddo - return - end + end subroutine thermcell_main_mars + +END MODULE thermcell_main_mars_mod Index: trunk/LMDZ.MARS/libf/phymars/vdif_cd_mod.F90 =================================================================== --- trunk/LMDZ.MARS/libf/phymars/vdif_cd_mod.F90 (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/vdif_cd_mod.F90 (revision 3727) @@ -297,6 +297,4 @@ ENDIF - RETURN - END SUBROUTINE vdif_cd Index: trunk/LMDZ.MARS/libf/phymars/vdif_kc.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/vdif_kc.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/vdif_kc.F (revision 3727) @@ -1,2 +1,8 @@ + MODULE vdif_kc_mod + + IMPLICIT NONE + + CONTAINS + SUBROUTINE vdif_kc(ngrid,nlay,nq,dt,g, & zlev,zlay,u,v,teta,cd,q2,km,kn,zq) @@ -634,4 +640,5 @@ ! call writediagfi(ngrid,'vdif_kc_sm','','',3,sm(:,1:nlay)) - RETURN - END + END SUBROUTINE vdif_kc + + END MODULE vdif_kc_mod Index: trunk/LMDZ.MARS/libf/phymars/vdifc_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/vdifc_mod.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/vdifc_mod.F (revision 3727) @@ -38,4 +38,6 @@ use comsoil_h, only: layer, mlayer,adsorption_soil use vdif_cd_mod, only: vdif_cd + use vdif_kc_mod, only: vdif_kc + use yamada4_mod, only: yamada4 use lmdz_call_atke, only: call_atke use dust_windstress_lift_mod, only: dust_windstress_lift Index: trunk/LMDZ.MARS/libf/phymars/vlz_fi.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/vlz_fi.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/vlz_fi.F (revision 3727) @@ -1,2 +1,8 @@ + MODULE vlz_fi_mod + + IMPLICIT NONE + + CONTAINS + SUBROUTINE vlz_fi(ngrid,nlay,q,pente_max,masse,w,wq) c @@ -194,4 +200,5 @@ enddo - return - end + END SUBROUTINE vlz_fi + + END MODULE vlz_fi_mod Index: trunk/LMDZ.MARS/libf/phymars/yamada4.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/yamada4.F (revision 3726) +++ trunk/LMDZ.MARS/libf/phymars/yamada4.F (revision 3727) @@ -1,2 +1,8 @@ + MODULE yamada4_mod + + IMPLICIT NONE + + CONTAINS + !************************************************************ !************************************************************ @@ -613,5 +619,6 @@ first=.false. - end + END SUBROUTINE yamada4 + SUBROUTINE vdif_q2(timestep,gravity,rconst,ngrid,nlay & ,plev,temp,kmy,q2) @@ -688,6 +695,7 @@ enddo - return - end + + END SUBROUTINE vdif_q2 + SUBROUTINE vdif_q2e(timestep,gravity,rconst,ngrid,nlay, & plev,temp,kmy,q2) @@ -750,3 +758,6 @@ - end + END SUBROUTINE vdif_q2e + + + END MODULE yamada4_mod