Only in oldmeso: .svn diff --ignore-blank-lines --context=3 -r oldgcm/aeropacity.F oldmeso/aeropacity.F *** oldgcm/aeropacity.F Thu Sep 30 19:55:34 2010 --- oldmeso/aeropacity.F Tue Jan 25 16:49:09 2011 *************** *** 115,120 **** --- 115,132 ---- INTEGER,SAVE :: i_ice=0 ! water ice CHARACTER(LEN=20) :: tracername ! to temporarly store text + c ********************************************************** + c Declaration special local dust storm TASI + logical localstorm + real taulocref,ztoploc,radloc,lonloc,latloc + integer ltoploc + real tauloc ! diagnostic only + c ********************************************************** + + + + + call zerophys(ngrid*naerkind,tau) ! identify tracers *************** *** 297,302 **** --- 309,362 ---- ENDDO ENDDO + c *************************************************************** + c SPECIAL LOCAL DUST STORM TASI + c We modify only aerosol calculated above where the local dust storm is + + localstorm = .true. + if (localstorm) then + taulocref = 2 !10 ! ref optical depth of the local dust storm + ztoploc = 11 ! target pseudo-altitude of local storm (km) + radloc = 4. ! radius of dust storm (degree) + lonloc=-3 ! center longitude of storm (deg) + latloc=-2. ! center latitude of storm (deg) + + DO ig=1,ngrid + c Where is the dust storm: + if (((lati(ig)*180./pi-latloc)**2 + & + (long(ig)*180./pi -lonloc)**2).le.(radloc**2))then + c Computing where is the top level of the localstorm + DO l=nlayer,1,-1 + ltoploc=l+1 + if(-10*log(pplev(ig,l)/pplev(ig,1)).lt.ztoploc)goto 88 + END DO + 88 continue + DO l=1,ltoploc-1 + aerosol(ig,l,1)=max(aerosol(ig,l,1), + & taulocref* (pplev(ig,l)-pplev(ig,l+1)) + & /(pplev(ig,1)-pplev(ig,ltoploc))) + END DO + + c diagnostic + write(*,*) + write(*,*) 'lat,lon',lati(ig)*180./pi,long(ig)*180./pi + write(*,*) 'true dustorm top pseudo-height (km) = ', + & -10*log(pplev(ig,ltoploc)/pplev(ig,1)) + c tauloc=0. + c DO l=1,nlayer + c tauloc = tauloc + aerosol(ig,l,1) + c write(*,*) 'below ', + c & -10*log(pplev(ig,l+1)/pplev(ig,1)), + c & 'km, tau=', tauloc + c ENDDO + + endif + END DO + endif + c *************************************************************** + + + CALL zerophys(ngrid,taudustvis) CALL zerophys(ngrid,taudusttes) DO l=1,nlayer *************** *** 431,440 **** ENDDO c 3. Outputs IF (ngrid.NE.1) THEN ! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl', ! & ' ',2,taucloudtes) ! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl', ! & ' ',2,taucloudtes) ELSE CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU') ENDIF --- 491,500 ---- ENDDO c 3. Outputs IF (ngrid.NE.1) THEN ! ! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl', ! ! & ' ',2,taucloudtes) ! ! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl', ! ! & ' ',2,taucloudtes) ELSE CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU') ENDIF Only in oldgcm: aeropacity.F.old diff --ignore-blank-lines --context=3 -r oldgcm/aeropacity.F~ oldmeso/aeropacity.F~ *** oldgcm/aeropacity.F~ Tue Feb 2 15:41:20 2010 --- oldmeso/aeropacity.F~ Tue Jan 25 16:49:10 2011 *************** *** 2,7 **** --- 2,9 ---- & tauref,tau,aerosol,reffrad, & QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d) + ! to use 'getin' + USE ioipsl_getincom IMPLICIT NONE c======================================================================= c subject: *************** *** 160,165 **** --- 162,171 ---- WRITE(*,*) "Qext/Qabs(IR): ",mqextsqabs(:,iaer) ENDDO + ! load value of tauvis from callphys.def (if given there, + ! otherwise default value read from starfi.nc file will be used) + call getin("tauvis",tauvis) + firstcall=.false. END IF *************** *** 178,186 **** c Vertical column optical depth at 700.Pa c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! IF(iaervar.eq.1) THEN do ig=1, ngridmx ! tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste as read in starfi end do ELSE IF (iaervar.eq.2) THEN ! << "Viking" Scenario>> --- 184,193 ---- c Vertical column optical depth at 700.Pa c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! IF(iaervar.eq.1) THEN do ig=1, ngridmx ! tauref(ig)=max(tauvis,1.e-9) ! tauvis=cste (set in callphys.def ! ! or read in starfi end do ELSE IF (iaervar.eq.2) THEN ! << "Viking" Scenario>> *************** *** 301,310 **** IF (ngrid.NE.1) THEN ! CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR', ! & ' ',2,taudusttes) ! IF (callstats) THEN ! CALL wstats(ngridmx,'taudustTES','dust abs IR', ! & ' ',2,taudusttes) ! ENDIF ELSE CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU') ENDIF --- 309,316 ---- IF (ngrid.NE.1) THEN ! CALL WRITEDIAGFI(ngridmx,'taudustTES','dust abs IR', ! & ' ',2,taudusttes) ! ! CALL wstats(ngridmx,'taudustTES','dust abs IR', ! ! & ' ',2,taudusttes) ELSE CALL writeg1d(ngrid,1,taudusttes,'taudusttes','NU') ENDIF *************** *** 420,431 **** ENDDO c 3. Outputs IF (ngrid.NE.1) THEN ! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl', ! & ' ',2,taucloudtes) ! IF (callstats) THEN ! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl', ! & ' ',2,taucloudtes) ! ENDIF ELSE CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU') ENDIF --- 426,435 ---- ENDDO c 3. Outputs IF (ngrid.NE.1) THEN ! ! CALL WRITEDIAGFI(ngridmx,'tauTES','tauabs IR refwvl', ! ! & ' ',2,taucloudtes) ! ! CALL wstats(ngridmx,'tauTES','tauabs IR refwvl', ! ! & ' ',2,taucloudtes) ELSE CALL writeg1d(ngrid,1,taucloudtes,'tautes','NU') ENDIF Only in oldgcm: aeroptproperties.F.old Only in oldmeso: assim_aeropacity.F Only in oldmeso: assim_readtesassim.F90 Only in oldgcm: calldrag_noro.F diff --ignore-blank-lines --context=3 -r oldgcm/callkeys.h oldmeso/callkeys.h *** oldgcm/callkeys.h Tue Feb 2 15:41:20 2010 --- oldmeso/callkeys.h Tue Jan 25 15:17:44 2011 *************** *** 39,44 **** --- 39,45 ---- real alphan real solarcondate + integer ecri_phys integer iddist integer iaervar integer iradia *************** *** 52,57 **** --- 53,59 ---- integer dustbin logical active,doubleq,lifting,callddevil,scavenging logical sedimentation,activice,water,caps + !!! plus besoin de iceparty ?? logical photochem integer nqchem_min diff --ignore-blank-lines --context=3 -r oldgcm/callradite.F oldmeso/callradite.F *** oldgcm/callradite.F Tue Feb 2 15:41:20 2010 --- oldmeso/callradite.F Tue Jan 25 16:49:09 2011 *************** *** 20,28 **** c c The purpose of this subroutine is to: c 1) Make some initial calculation at first call ! c 2) Compute the 3D scattering parameters depending on the c size distribution of the different tracers (added by JBM) ! c 3) call "lwmain" and "swmain" c c c authors: --- 20,32 ---- c c The purpose of this subroutine is to: c 1) Make some initial calculation at first call ! c 2) Split the calculation in several sub-grid ! c ("sub-domain") to save memory and ! c be able run on a workstation at high resolution ! c The sub-grid size is defined in dimradmars.h ! c 3) Compute the 3D scattering parameters depending on the c size distribution of the different tracers (added by JBM) ! c 4) call "lwmain" and "swmain" c c c authors: *************** *** 73,81 **** c In other routines, nlayermx -> nflev. c Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn. c ! c > J.-B. Madeleine 09W30 ! c ! c Removed the variable's splitting, which is now obsolete. c c ---------- c Here, solar band#1 is spectral interval between "long1vis" and "long2vis" --- 77,85 ---- c In other routines, nlayermx -> nflev. c Routines affected: lwflux, lwi, lwmain, lwxb, lwxd, lwxn. c ! c > J.-B. Madeleine 10W12 ! c This version uses the variable's splitting, which can be usefull ! c when performing very high resolution simulation like LES. c c ---------- c Here, solar band#1 is spectral interval between "long1vis" and "long2vis" *************** *** 174,191 **** c Local variables : c ----------------- ! INTEGER j,l,ig,n real cste_mars ! solar constant on Mars (Wm-2) REAL ptlev(ngridmx,nlayermx+1) ! REAL dp(ngrid,nflev) ! REAL dt0(ngrid) c Thermal IR net radiative budget (W m-2) ! REAL netrad(ngrid,nflev) ! REAL fluxd_sw(ngrid,nflev+1,2) ! REAL fluxu_sw(ngrid,nflev+1,2) c Aerosol size distribution REAL :: reffrad(ngrid,nlayer,naerkind) --- 178,220 ---- c Local variables : c ----------------- ! INTEGER j,l,ig,n,ich,iaer ! INTEGER jd,ig0,nd real cste_mars ! solar constant on Mars (Wm-2) REAL ptlev(ngridmx,nlayermx+1) ! ! INTEGER ndomain ! parameter (ndomain = (ngridmx-1) / ndomainsz + 1) c Thermal IR net radiative budget (W m-2) ! real znetrad(ndomainsz,nflev) ! ! real zfluxd_sw(ndomainsz,nflev+1,2) ! real zfluxu_sw(ndomainsz,nflev+1,2) ! ! REAL zplev(ndomainsz,nflev+1) ! REAL zztlev(ndomainsz,nflev+1) ! REAL zplay(ndomainsz,nflev) ! REAL zt(ndomainsz,nflev) ! REAL zaerosol(ndomainsz,nflev,naerkind) ! REAL zalbedo(ndomainsz,2) ! REAL zdp(ndomainsz,nflev) ! REAL zdt0(ndomainsz) ! ! REAL zzdtlw(ndomainsz,nflev) ! REAL zzdtsw(ndomainsz,nflev) ! REAL zzflux(ndomainsz,6) ! real zrmuz ! ! REAL :: zQVISsQREF3d(ndomainsz,nflev,nsun,naerkind) ! REAL :: zomegaVIS3d(ndomainsz,nflev,nsun,naerkind) ! REAL :: zgVIS3d(ndomainsz,nflev,nsun,naerkind) ! ! REAL :: zQIRsQREF3d(ndomainsz,nflev,nir,naerkind) ! REAL :: zomegaIR3d(ndomainsz,nflev,nir,naerkind) ! REAL :: zgIR3d(ndomainsz,nflev,nir,naerkind) c Aerosol size distribution REAL :: reffrad(ngrid,nlayer,naerkind) *************** *** 249,254 **** --- 278,296 ---- CALL SUAER CALL SULW + write(*,*) 'Splitting radiative calculations: ', + $ ' ngridmx,ngrid,ndomainsz,ndomain', + $ ngridmx,ngrid,ndomainsz,ndomain + if (ngridmx .EQ. 1) then + if (ndomainsz .NE. 1) then + print* + print*,'ATTENTION !!!' + print*,'pour tourner en 1D, ' + print*,'fixer ndomainsz=1 dans phymars/dimradmars.h' + print* + call exit(1) + endif + endif firstcall=.false. END IF *************** *** 273,315 **** & tauref,tau,aerosol,reffrad, & QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d) do l=1,nlaylte ! do ig = 1, ngrid c Thickness of each layer (Pa) : ! dp(ig,l)= pplev(ig,l) - pplev(ig,l+1) enddo enddo c Intermediate levels: (computing tlev) c --------------------------------------- c Extrapolation for the air temperature above the surface ! DO ig=1, ngrid ! ptlev(ig,1)=pt(ig,1)+ ! s (pplev(ig,1)-pplay(ig,1))* ! s (pt(ig,1)-pt(ig,2))/(pplay(ig,1)-pplay(ig,2)) ! dt0(ig) = tsurf(ig) - ptlev(ig,1) ENDDO DO l=2,nlaylte ! DO ig=1, ngrid ! ptlev(ig,l)=0.5*(pt(ig,l-1)+pt(ig,l)) ENDDO ENDDO ! DO ig=1, ngrid ! ptlev(ig,nlaylte+1)=pt(ig,nlaylte) ENDDO c Longwave ("lw") radiative transfer (= thermal infrared) c ------------------------------------------------------- ! call lwmain (icount,ngrid,nflev ! . ,dp,dt0,emis,pplev,ptlev,pt ! . ,aerosol,dtlw ! . ,fluxsurf_lw,fluxtop_lw ! . ,netrad ! & ,QIRsQREF3d,omegaIR3d,gIR3d) c Shortwave ("sw") radiative transfer (= solar radiation) c ------------------------------------------------------- --- 315,416 ---- & tauref,tau,aerosol,reffrad, & QREFvis3d,QREFir3d,omegaREFvis3d,omegaREFir3d) + c Starting loop on sub-domain + c ---------------------------- + + DO jd=1,ndomain + ig0=(jd-1)*ndomainsz + if (jd.eq.ndomain) then + nd=ngridmx-ig0 + else + nd=ndomainsz + endif + + c Spliting input variable in sub-domain input variables + c --------------------------------------------------- + + do l=1,nlaylte + do ig = 1,nd + do iaer = 1, naerkind + do ich = 1, nsun + zQVISsQREF3d(ig,l,ich,iaer) = + & QVISsQREF3d(ig0+ig,l,ich,iaer) + zomegaVIS3d(ig,l,ich,iaer) = + & omegaVIS3d(ig0+ig,l,ich,iaer) + zgVIS3d(ig,l,ich,iaer) = + & gVIS3d(ig0+ig,l,ich,iaer) + enddo + do ich = 1, nir + zQIRsQREF3d(ig,l,ich,iaer) = + & QIRsQREF3d(ig0+ig,l,ich,iaer) + zomegaIR3d(ig,l,ich,iaer) = + & omegaIR3d(ig0+ig,l,ich,iaer) + zgIR3d(ig,l,ich,iaer) = + & gIR3d(ig0+ig,l,ich,iaer) + enddo + enddo + enddo + enddo + + do l=1,nlaylte+1 + do ig = 1,nd + zplev(ig,l) = pplev(ig0+ig,l) + enddo + enddo + do l=1,nlaylte ! do ig = 1,nd ! zplay(ig,l) = pplay(ig0+ig,l) ! zt(ig,l) = pt(ig0+ig,l) c Thickness of each layer (Pa) : ! zdp(ig,l)= pplev(ig0+ig,l) - pplev(ig0+ig,l+1) enddo enddo + do n=1,naerkind + do l=1,nlaylte + do ig=1,nd + zaerosol(ig,l,n) = aerosol(ig0+ig,l,n) + enddo + enddo + enddo + + do j=1,2 + do ig = 1,nd + zalbedo(ig,j) = albedo(ig0+ig,j) + enddo + enddo + c Intermediate levels: (computing tlev) c --------------------------------------- c Extrapolation for the air temperature above the surface ! DO ig=1,nd ! zztlev(ig,1)=zt(ig,1)+ ! s (zplev(ig,1)-zplay(ig,1))* ! s (zt(ig,1)-zt(ig,2))/(zplay(ig,1)-zplay(ig,2)) ! zdt0(ig) = tsurf(ig0+ig) - zztlev(ig,1) ENDDO DO l=2,nlaylte ! DO ig=1, nd ! zztlev(ig,l)=0.5*(zt(ig,l-1)+zt(ig,l)) ENDDO ENDDO ! DO ig=1, nd ! zztlev(ig,nlaylte+1)=zt(ig,nlaylte) ENDDO c Longwave ("lw") radiative transfer (= thermal infrared) c ------------------------------------------------------- ! call lwmain (ig0,icount,nd,nflev ! . ,zdp,zdt0,emis(ig0+1),zplev,zztlev,zt ! . ,zaerosol,zzdtlw ! . ,fluxsurf_lw(ig0+1),fluxtop_lw(ig0+1) ! . ,znetrad ! & ,zQIRsQREF3d,zomegaIR3d,zgIR3d) c Shortwave ("sw") radiative transfer (= solar radiation) c ------------------------------------------------------- *************** *** 317,337 **** c 1370 W.m-2 is the solar constant at 1 AU. cste_mars=1370./(dist_sol*dist_sol) ! call swmain ( ngrid, nflev, ! S cste_mars, albedo, ! S mu0, dp, pplev, aerosol, fract, ! S dtsw, fluxd_sw, fluxu_sw, ! & QVISsQREF3d,omegaVIS3d,gVIS3d) c ------------------------------------------------------------ ! do ig = 1, ngrid ! fluxsurf_sw(ig,1) = fluxd_sw(ig,1,1) ! fluxsurf_sw(ig,2) = fluxd_sw(ig,1,2) ! fluxtop_sw(ig,1) = fluxu_sw(ig,nlaylte+1,1) ! fluxtop_sw(ig,2) = fluxu_sw(ig,nlaylte+1,2) enddo c Zero tendencies for any remaining layers between nlaylte and nlayer if (nlayer.gt.nlaylte) then do l = nlaylte+1, nlayer --- 418,455 ---- c 1370 W.m-2 is the solar constant at 1 AU. cste_mars=1370./(dist_sol*dist_sol) ! call swmain ( nd, nflev, ! S cste_mars, zalbedo, ! S mu0(ig0+1), zdp, zplev, zaerosol, fract(ig0+1), ! S zzdtsw, zfluxd_sw, zfluxu_sw, ! & zQVISsQREF3d,zomegaVIS3d,zgVIS3d) c ------------------------------------------------------------ + c Un-spliting output variable from sub-domain input variables + c ------------------------------------------------------------ + + do l=1,nlaylte + do ig = 1,nd + dtlw(ig0+ig,l) = zzdtlw(ig,l) + dtsw(ig0+ig,l) = zzdtsw(ig,l) + enddo + enddo ! do l=1,nlaylte+1 ! do ig = 1,nd ! ptlev(ig0+ig,l) = zztlev(ig,l) ! enddo enddo + do ig = 1,nd + fluxsurf_sw(ig0+ig,1) = zfluxd_sw(ig,1,1) + fluxsurf_sw(ig0+ig,2) = zfluxd_sw(ig,1,2) + fluxtop_sw(ig0+ig,1) = zfluxu_sw(ig,nlaylte+1,1) + fluxtop_sw(ig0+ig,2) = zfluxu_sw(ig,nlaylte+1,2) + enddo + + ENDDO ! (boucle jd=1, ndomain) + c Zero tendencies for any remaining layers between nlaylte and nlayer if (nlayer.gt.nlaylte) then do l = nlaylte+1, nlayer Only in oldgcm: callradite.F.old Only in oldmeso: callradite.F~ diff --ignore-blank-lines --context=3 -r oldgcm/datafile.h oldmeso/datafile.h *** oldgcm/datafile.h Thu Sep 23 18:53:00 2010 --- oldmeso/datafile.h Mon Jan 24 12:16:55 2011 *************** *** 4,11 **** ! Address of the directory containing tables of data needed by the GCM character (len=100) :: datafile ! ! data datafile /'/u/forget/WWW/datagcm/datafile'/ ! !! data datafile /'/home/forget/datafile'/ ! data datafile /'/d2/emlmd/work_TASI/dust_scenarios_new/flush/LMDZ.& ! &MARS.BETA/datafile'/ !----------------------------------------------------------------------- --- 4,10 ---- ! Address of the directory containing tables of data needed by the GCM character (len=100) :: datafile ! !! path to WRF data ! data datafile /'/u/forget/WWW/datagcm/datafile'/ ! ! data datafile /'/d5/aslmd/LMD_MM_MARS_DATA/dust'/ !----------------------------------------------------------------------- Only in oldmeso: diff.cmd Only in oldmeso: diff.cmd~ Only in oldmeso: diff.log Only in oldmeso: diff.log.h diff --ignore-blank-lines --context=3 -r oldgcm/dimphys.h oldmeso/dimphys.h *** oldgcm/dimphys.h Tue Feb 2 15:41:20 2010 --- oldmeso/dimphys.h Tue Jan 25 16:49:09 2011 *************** *** 1,12 **** !----------------------------------------------------------------------- ! INCLUDE 'dimphys.h' ! ! ngridmx : number of horizontal grid points ! ! note: the -1/jjm term will be 0; unless jj=1 ! integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm) ! ! nlayermx : number of atmospheric layers ! integer, parameter :: nlayermx = llm ! ! nsoilmx : number of subterranean layers ! !EM: old soil routine: integer, parameter :: nsoilmx = 10 ! integer, parameter :: nsoilmx = 18 !----------------------------------------------------------------------- --- 1,13 ---- !----------------------------------------------------------------------- ! INCLUDE 'dimphys.h' ! ! INTEGER, parameter :: wiim=60 ! INTEGER, parameter :: wjjm=60 ! INTEGER, PARAMETER :: ngridmx=3600 ! INTEGER, parameter :: nlayermx=60 ! INTEGER, PARAMETER :: nsoilmx=10 ! !----------------------------------------------------------------------- + + diff --ignore-blank-lines --context=3 -r oldgcm/dimradmars.h oldmeso/dimradmars.h *** oldgcm/dimradmars.h Tue Feb 2 15:41:20 2010 --- oldmeso/dimradmars.h Tue Jan 25 16:49:09 2011 *************** *** 8,17 **** ! nflev: number of vertical layer ! ndlon,ndlo2: number of horizontal points ! INTEGER NFLEV,NDLON,NDLO2 ! parameter (NFLEV=nlayermx,NDLON=ngridmx) parameter (NDLO2=NDLON) ! Number of kind of tracer radiative properties --- 8,24 ---- ! nflev: number of vertical layer ! ndlon,ndlo2: number of horizontal points + ! Splitting of horizontal grid + ! NDLO2 et ndomainsz pour le decoupage de l'appel a la physique + ! ATTENTION: Il faut 1 < ndomainsz =< ngridmx ! INTEGER NFLEV,NDLON,NDLO2,ndomainsz ! ! parameter (ndomainsz=ngridmx) ! parameter (ndomainsz=(ngridmx-1)/20 + 1) ! ! parameter (ndomainsz=(ngridmx-1)/5 + 1) ! ! parameter (NFLEV=nlayermx,NDLON=ndomainsz) ! avec decoupage parameter (NDLO2=NDLON) ! Number of kind of tracer radiative properties Only in oldgcm: drag_noro.F diff --ignore-blank-lines --context=3 -r oldgcm/dustlift.F oldmeso/dustlift.F *** oldgcm/dustlift.F Tue Feb 2 15:41:20 2010 --- oldmeso/dustlift.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice, $ dqslift) IMPLICIT NONE --- 1,5 ---- ! SUBROUTINE dustlift(ngrid,nlay,nq,rho, ! $ pcdh_true,pcdh,co2ice, $ dqslift) IMPLICIT NONE *************** *** 41,47 **** REAL ust,us REAL stress_seuil SAVE stress_seuil ! DATA stress_seuil/0.0225/ ! stress seuil soulevement (N.m2) c --------------------------------- --- 42,69 ---- REAL ust,us REAL stress_seuil SAVE stress_seuil ! c DATA stress_seuil/0.0225/ ! stress seuil soulevement (N.m2) ! !****WRF ! !****WRF: additional ASCII file to define dust opacity ! REAL alpha ! INTEGER ierr ! OPEN(99,file='stress.def',status='old',form='formatted' ! . ,iostat=ierr) ! IF(ierr.NE.0) THEN ! stress_seuil = 0.0225 ! alpha = 1. ! write(*,*) 'No file stress.def - set ', stress_seuil, alpha ! !stop ! ELSE ! READ(99,*) stress_seuil ! READ(99,*) alpha ! write(*,*) 'definir seuil stress : ', stress_seuil, alpha ! CLOSE(99) ! ENDIF ! alpha_lift(1) = alpha ! !****WRF ! !****WRF ! c --------------------------------- Only in oldmeso: gr_fi_dyn.F Only in oldgcm: gwprofil.F Only in oldgcm: gwstress.F Only in oldgcm: inifis.F Only in oldgcm: inifis.F~ diff --ignore-blank-lines --context=3 -r oldgcm/initracer.F oldmeso/initracer.F *** oldgcm/initracer.F Thu Feb 4 10:47:02 2010 --- oldmeso/initracer.F Tue Jan 25 16:49:09 2011 *************** *** 43,50 **** #include "advtrac.h" #include "comgeomfi.h" #include "watercap.h" ! #include "chimiedata.h" ! real qsurf(ngridmx,nqmx) ! tracer on surface (e.g. kg.m-2) real co2ice(ngridmx) ! co2 ice mass on surface (e.g. kg.m-2) --- 43,49 ---- #include "advtrac.h" #include "comgeomfi.h" #include "watercap.h" ! #include "chimiedata.h" real qsurf(ngridmx,nqmx) ! tracer on surface (e.g. kg.m-2) real co2ice(ngridmx) ! co2 ice mass on surface (e.g. kg.m-2) *************** *** 436,443 **** Qext(iq)=0. alpha_lift(iq) =0. alpha_devil(iq)=0. ! qextrhor(iq)= 0. ! endif enddo ! do iq=1,nqmx endif --- 435,442 ---- Qext(iq)=0. alpha_lift(iq) =0. alpha_devil(iq)=0. ! qextrhor(iq)= 0. ! endif enddo ! do iq=1,nqmx endif *************** *** 448,454 **** Qext(igcm_h2o_vap)=0. alpha_lift(igcm_h2o_vap) =0. alpha_devil(igcm_h2o_vap)=0. ! qextrhor(igcm_h2o_vap)= 0. c "Dryness coefficient" controlling the evaporation and c sublimation from the ground water ice (close to 1) --- 447,453 ---- Qext(igcm_h2o_vap)=0. alpha_lift(igcm_h2o_vap) =0. alpha_devil(igcm_h2o_vap)=0. ! qextrhor(igcm_h2o_vap)= 0. c "Dryness coefficient" controlling the evaporation and c sublimation from the ground water ice (close to 1) Only in oldmeso: jb_phymars diff --ignore-blank-lines --context=3 -r oldgcm/lwflux.F oldmeso/lwflux.F *** oldgcm/lwflux.F Tue Feb 2 15:41:20 2010 --- oldmeso/lwflux.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! subroutine lwflux (kdlon,kflev,dp . ,bsurf,btop,blev,blay,dbsublay . ,tlay, tlev, dt0 ! pour sortie dans g2d uniquement . ,emis --- 1,4 ---- ! subroutine lwflux (ig0,kdlon,kflev,dp . ,bsurf,btop,blev,blay,dbsublay . ,tlay, tlev, dt0 ! pour sortie dans g2d uniquement . ,emis *************** *** 26,31 **** --- 26,32 ---- c --------- c inputs: c ------- + integer ig0 integer kdlon ! part of ngrid integer kflev ! part of nlayer *************** *** 62,68 **** c 0.2 local arrays c ------------ ! integer ja,jl,j,i,ig1d,l,ndim parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2)) real ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2) --- 63,69 ---- c 0.2 local arrays c ------------ ! integer ja,jl,j,i,ig1d,ig,l,ndim parameter(ndim = ndlon*(nuco2+1)*(nflev+2)*(nflev+2)) real ksidb (ndlon,nuco2+1,0:nflev+1,0:nflev+1) ! net exchange rate (W/m2) *************** *** 91,97 **** do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,i,j) = xi(jl,ja,i,j) . * (blay(jl,ja,j)-blay(jl,ja,i)) c ksidb reciprocity c ----------------- --- 92,98 ---- do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,i,j) = xi(ig0+jl,ja,i,j) . * (blay(jl,ja,j)-blay(jl,ja,i)) c ksidb reciprocity c ----------------- *************** *** 110,116 **** do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,i,0) = xi(jl,ja,0,i) . * (bsurf(jl,ja)-blay(jl,ja,i)) c ksidb reciprocity c ----------------- --- 111,117 ---- do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,i,0) = xi(ig0+jl,ja,0,i) . * (bsurf(jl,ja)-blay(jl,ja,i)) c ksidb reciprocity c ----------------- *************** *** 129,135 **** do jl = 1,kdlon ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) ! . - xi_ground(jl,ja) . * (blev(jl,ja,1)-blay(jl,ja,1)) cc ksidb reciprocity --- 130,136 ---- do jl = 1,kdlon ksidb(jl,ja,1,0) = ksidb(jl,ja,1,0) ! . - xi_ground(ig0+jl,ja) . * (blev(jl,ja,1)-blay(jl,ja,1)) cc ksidb reciprocity *************** *** 147,153 **** do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,i,nlaylte+1) = xi(jl,ja,i,nlaylte+1) . * (-blay(jl,ja,i)) c ksidb reciprocity c ----------------- --- 148,154 ---- do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,i,nlaylte+1) = xi(ig0+jl,ja,i,nlaylte+1) . * (-blay(jl,ja,i)) c ksidb reciprocity c ----------------- *************** *** 164,170 **** do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,0,nlaylte+1) = xi(jl,ja,0,nlaylte+1) . * (-bsurf(jl,ja)) c ksidb reciprocity --- 165,171 ---- do ja = 1,nuco2 do jl = 1,kdlon ! ksidb(jl,ja,0,nlaylte+1) = xi(ig0+jl,ja,0,nlaylte+1) . * (-bsurf(jl,ja)) c ksidb reciprocity *************** *** 259,265 **** do jl = 1,kdlon fluxground(jl) = fluxground(jl) ! . + xi(jl,ja,0,i) * (blay(jl,ja,i)) enddo enddo --- 260,266 ---- do jl = 1,kdlon fluxground(jl) = fluxground(jl) ! . + xi(ig0+jl,ja,0,i) * (blay(jl,ja,i)) enddo enddo *************** *** 305,311 **** do jl = 1,kdlon coefu(jl,ja,i,j) =0. do l=j,nlaylte+1 ! coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(jl,ja,l,i) end do enddo --- 306,312 ---- do jl = 1,kdlon coefu(jl,ja,i,j) =0. do l=j,nlaylte+1 ! coefu(jl,ja,i,j)=coefu(jl,ja,i,j)+xi(ig0+jl,ja,l,i) end do enddo *************** *** 333,339 **** do jl = 1,kdlon coefd(jl,ja,i,j) =0. do l=0,j-1 ! coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(jl,ja,l,i) end do enddo enddo --- 334,340 ---- do jl = 1,kdlon coefd(jl,ja,i,j) =0. do l=0,j-1 ! coefd(jl,ja,i,j)=coefd(jl,ja,i,j)+xi(ig0+jl,ja,l,i) end do enddo enddo *************** *** 357,362 **** --- 358,364 ---- c ---------------- c ig1d: point de la grille physique ou on veut faire la sortie + c ig0+1: point du decoupage de la grille physique c#ifdef undim if (callg2d) then *************** *** 364,370 **** ig1d = ngridmx/2 + 1 c ig1d = ngridmx ! print*, 'Sortie g2d: ig1d =', ig1d c-------------------------------------------- c Ouverture de g2d.dat --- 366,376 ---- ig1d = ngridmx/2 + 1 c ig1d = ngridmx ! if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon) ! . .OR. ngridmx.EQ.1 ) then ! ! ig = ig1d-ig0 ! print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0 c-------------------------------------------- c Ouverture de g2d.dat *************** *** 403,409 **** do j = 0,nlaylte+1 do i = 0,nlaylte+1 g2d_irec=g2d_irec+1 ! reel4 = ksidb(ig1d,ja,i,j) write(47,rec=g2d_irec) reel4 enddo enddo --- 409,415 ---- do j = 0,nlaylte+1 do i = 0,nlaylte+1 g2d_irec=g2d_irec+1 ! reel4 = ksidb(ig,ja,i,j) write(47,rec=g2d_irec) reel4 enddo enddo *************** *** 412,418 **** do j = 0,nlaylte+1 do i = 0,nlaylte+1 g2d_irec=g2d_irec+1 ! reel4 = ksidb(ig1d,3,i,j) write(47,rec=g2d_irec) reel4 enddo enddo --- 418,424 ---- do j = 0,nlaylte+1 do i = 0,nlaylte+1 g2d_irec=g2d_irec+1 ! reel4 = ksidb(ig,3,i,j) write(47,rec=g2d_irec) reel4 enddo enddo *************** *** 423,429 **** do j = 1 , nlaylte do i = 0 , nlaylte+1 ! dpsgcp(i,j) = dp(ig1d,j) / gcp enddo enddo --- 429,435 ---- do j = 1 , nlaylte do i = 0 , nlaylte+1 ! dpsgcp(i,j) = dp(ig,j) / gcp enddo enddo *************** *** 437,443 **** c print*,'gcp: ',gcp c print* c do i = 0 , nlaylte+1 ! c print*,i,'dp: ',dp(ig1d,i) c enddo c print* c do i = 0 , nlaylte+1 --- 443,449 ---- c print*,'gcp: ',gcp c print* c do i = 0 , nlaylte+1 ! c print*,i,'dp: ',dp(ig,i) c enddo c print* c do i = 0 , nlaylte+1 *************** *** 458,469 **** do j = 1 , nlaylte do i = 0 , nlaylte+1 ! temp(i,j) = tlay(ig1d,j) enddo enddo do i = 0 , nlaylte+1 ! temp(i,0) = tlev(ig1d,1)+dt0(ig1d) ! temperature surface temp(i,nlaylte+1) = 0. ! temperature espace (=0) enddo --- 464,475 ---- do j = 1 , nlaylte do i = 0 , nlaylte+1 ! temp(i,j) = tlay(ig,j) enddo enddo do i = 0 , nlaylte+1 ! temp(i,0) = tlev(ig,1)+dt0(ig) ! temperature surface temp(i,nlaylte+1) = 0. ! temperature espace (=0) enddo *************** *** 475,503 **** enddo enddo ! write(76,*) 'ig1d =', ig1d write(76,*) 'nlaylte', nlaylte write(76,*) 'nflev', nflev write(76,*) 'kdlon', kdlon write(76,*) 'ndlo2', ndlo2 write(76,*) 'ndlon', ndlon do ja=1,4 ! write(76,*) 'bsurf', ja, bsurf(ig1d,ja) ! write(76,*) 'btop', ja, btop(ig1d,ja) do j=1,nlaylte+1 ! write(76,*) 'blev', ja, j, blev(ig1d,ja,j) enddo do j=1,nlaylte ! write(76,*) 'blay', ja, j, blay(ig1d,ja,j) enddo do j=1,2*nlaylte ! write(76,*) 'dbsublay', ja, j, dbsublay(ig1d,ja,j) enddo enddo c************************************************************************ c#endif endif ! callg2d --- 481,510 ---- enddo enddo ! write(76,*) 'ig1d, ig, ig0', ig1d, ig, ig0 write(76,*) 'nlaylte', nlaylte write(76,*) 'nflev', nflev write(76,*) 'kdlon', kdlon write(76,*) 'ndlo2', ndlo2 write(76,*) 'ndlon', ndlon do ja=1,4 ! write(76,*) 'bsurf', ja, bsurf(ig,ja) ! write(76,*) 'btop', ja, btop(ig,ja) do j=1,nlaylte+1 ! write(76,*) 'blev', ja, j, blev(ig,ja,j) enddo do j=1,nlaylte ! write(76,*) 'blay', ja, j, blay(ig,ja,j) enddo do j=1,2*nlaylte ! write(76,*) 'dbsublay', ja, j, dbsublay(ig,ja,j) enddo enddo + endif c************************************************************************ c#endif endif ! callg2d diff --ignore-blank-lines --context=3 -r oldgcm/lwi.F oldmeso/lwi.F *** oldgcm/lwi.F Tue Feb 2 15:41:20 2010 --- oldmeso/lwi.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! subroutine lwi (kdlon,kflev . ,psi,zdblay,pdp . ,newpcolc ) --- 1,4 ---- ! subroutine lwi (ig0,kdlon,kflev . ,psi,zdblay,pdp . ,newpcolc ) *************** *** 34,40 **** c --------- c ! integer kdlon,kflev real psi(ndlo2,kflev) . , zdblay(ndlo2,nir,kflev) --- 34,40 ---- c --------- c ! integer ig0,kdlon,kflev real psi(ndlo2,kflev) . , zdblay(ndlo2,nir,kflev) *************** *** 90,103 **** do jl = 1 , kdlon c ------------------- di(jl,i) = 1 + semit * (g / pdp(jl,i) / cpp) * ( ! . ( xi(jl,1,i,nlaylte+1) ! . + xi(jl,1,i,i+1) ! . + xi(jl,1,i,i-1) ) ! . * zdblay(jl,1,i) ! . + ( xi(jl,2,i,nlaylte+1) ! . + xi(jl,2,i,i+1) ! . + xi(jl,2,i,i-1) ) ! . * zdblay(jl,2,i) . ) c ------------------- enddo --- 90,103 ---- do jl = 1 , kdlon c ------------------- di(jl,i) = 1 + semit * (g / pdp(jl,i) / cpp) * ( ! . ( xi(ig0+jl,1,i,nlaylte+1) ! . + xi(ig0+jl,1,i,i+1) ! . + xi(ig0+jl,1,i,i-1) ) ! . * zdblay(jl,1,i) ! . + ( xi(ig0+jl,2,i,nlaylte+1) ! . + xi(ig0+jl,2,i,i+1) ! . + xi(ig0+jl,2,i,i-1) ) ! . * zdblay(jl,2,i) . ) c ------------------- enddo *************** *** 112,123 **** do jl = 1 , kdlon c ------------------- di(jl,nlaylte) = 1 + semit * (g / pdp(jl,nlaylte) / cpp) * ( ! . ( xi(jl,1,nlaylte,nlaylte+1) ! . + xi(jl,1,nlaylte,nlaylte-1) ) ! . * zdblay(jl,1,nlaylte) ! . + ( xi(jl,2,nlaylte,nlaylte+1) ! . + xi(jl,2,nlaylte,nlaylte-1) ) ! . * zdblay(jl,2,nlaylte) . ) c ------------------- enddo --- 110,121 ---- do jl = 1 , kdlon c ------------------- di(jl,nlaylte) = 1 + semit * (g / pdp(jl,nlaylte) / cpp) * ( ! . ( xi(ig0+jl,1,nlaylte,nlaylte+1) ! . + xi(ig0+jl,1,nlaylte,nlaylte-1) ) ! . * zdblay(jl,1,nlaylte) ! . + ( xi(ig0+jl,2,nlaylte,nlaylte+1) ! . + xi(ig0+jl,2,nlaylte,nlaylte-1) ) ! . * zdblay(jl,2,nlaylte) . ) c ------------------- enddo *************** *** 132,139 **** do jl = 1 , kdlon c ------------------- hi(jl,i) = - semit * (g / pdp(jl,i) / cpp) * ! . ( xi(jl,1,i,i+1) * zdblay(jl,1,i+1) ! . + xi(jl,2,i,i+1) * zdblay(jl,2,i+1) ) c ------------------- enddo enddo --- 129,136 ---- do jl = 1 , kdlon c ------------------- hi(jl,i) = - semit * (g / pdp(jl,i) / cpp) * ! . ( xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1) ! . + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1) ) c ------------------- enddo enddo *************** *** 148,155 **** do jl = 1 , kdlon c ------------------- bi(jl,i) = - semit * (g / pdp(jl,i) / cpp) * ! . ( xi(jl,1,i,i-1) * zdblay(jl,1,i-1) ! . + xi(jl,2,i,i-1) * zdblay(jl,2,i-1) ) c ------------------- enddo enddo --- 145,152 ---- do jl = 1 , kdlon c ------------------- bi(jl,i) = - semit * (g / pdp(jl,i) / cpp) * ! . ( xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1) ! . + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1) ) c ------------------- enddo enddo diff --ignore-blank-lines --context=3 -r oldgcm/lwmain.F oldmeso/lwmain.F *** oldgcm/lwmain.F Tue Feb 2 15:41:20 2010 --- oldmeso/lwmain.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! subroutine lwmain (icount,kdlon,kflev . ,dp,dt0,emis . ,plev,tlev,tlay,aerosol,coolrate . ,fluxground,fluxtop --- 1,4 ---- ! subroutine lwmain (ig0,icount,kdlon,kflev . ,dp,dt0,emis . ,plev,tlev,tlay,aerosol,coolrate . ,fluxground,fluxtop *************** *** 25,30 **** --- 25,31 ---- c --------- c inputs: c ------- + integer ig0 integer icount integer kdlon ! part of ngrid integer kflev ! part of nlayer *************** *** 48,56 **** real fluxtop(ndlo2) ! outgoing upward flux (W/m2) ("OLR") real netrad (ndlo2,kflev) ! radiative budget (W/m2) c Aerosol optical properties ! REAL :: QIRsQREF3d(ngridmx,nlayermx,nir,naerkind) ! REAL :: omegaIR3d(ngridmx,nlayermx,nir,naerkind) ! REAL :: gIR3d(ngridmx,nlayermx,nir,naerkind) c---------------------------------------------------------------------- c 0.2 local arrays --- 49,57 ---- real fluxtop(ndlo2) ! outgoing upward flux (W/m2) ("OLR") real netrad (ndlo2,kflev) ! radiative budget (W/m2) c Aerosol optical properties ! REAL :: QIRsQREF3d(ndlo2,kflev,nir,naerkind) ! REAL :: omegaIR3d(ndlo2,kflev,nir,naerkind) ! REAL :: gIR3d(ndlo2,kflev,nir,naerkind) c---------------------------------------------------------------------- c 0.2 local arrays *************** *** 127,133 **** if( mod(icount-1,ilwd).eq.0) then c print*, 'CALL of DISTANTS' ! call lwxd ( kdlon, kflev, emis . , aer_t, co2_u, co2_up) endif --- 128,134 ---- if( mod(icount-1,ilwd).eq.0) then c print*, 'CALL of DISTANTS' ! call lwxd ( ig0, kdlon, kflev, emis . , aer_t, co2_u, co2_up) endif *************** *** 136,142 **** if( mod(icount-1,ilwn).eq.0) then c print*, 'CALL of NEIGHBOURS' ! call lwxn ( kdlon, kflev . , dp . , aer_t, co2_u, co2_up) --- 137,143 ---- if( mod(icount-1,ilwn).eq.0) then c print*, 'CALL of NEIGHBOURS' ! call lwxn ( ig0, kdlon, kflev . , dp . , aer_t, co2_u, co2_up) *************** *** 146,152 **** if( mod(icount-1,ilwb).eq.0) then c print*, 'CALL of BOUNDARIES' ! call lwxb ( kdlon, kflev, emis . , aer_t, co2_u, co2_up) endif --- 147,153 ---- if( mod(icount-1,ilwb).eq.0) then c print*, 'CALL of BOUNDARIES' ! call lwxb ( ig0, kdlon, kflev, emis . , aer_t, co2_u, co2_up) endif *************** *** 155,161 **** c 4.0 cooling rate c ------------ ! call lwflux ( kdlon, kflev, dp . , bsurf, btop, blev, blay, dbsublay . , tlay, tlev, dt0 ! pour sortie dans g2d uniquement . , emis --- 156,162 ---- c 4.0 cooling rate c ------------ ! call lwflux ( ig0, kdlon, kflev, dp . , bsurf, btop, blev, blay, dbsublay . , tlay, tlev, dt0 ! pour sortie dans g2d uniquement . , emis *************** *** 186,192 **** c --------------------------- c c ! call lwi (kdlon,kflev,netrad,dblay,dp . , newcoolrate) c c Verif que (X sol,space) + somme(X i,sol) = 1 --- 187,193 ---- c --------------------------- c c ! call lwi (ig0,kdlon,kflev,netrad,dblay,dp . , newcoolrate) c c Verif que (X sol,space) + somme(X i,sol) = 1 diff --ignore-blank-lines --context=3 -r oldgcm/lwxb.F oldmeso/lwxb.F *** oldgcm/lwxb.F Tue Feb 2 15:41:20 2010 --- oldmeso/lwxb.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! subroutine lwxb (kdlon,kflev . ,emis . ,aer_t,co2_u,co2_up) --- 1,4 ---- ! subroutine lwxb (ig0,kdlon,kflev . ,emis . ,aer_t,co2_u,co2_up) *************** *** 58,64 **** c 0.2 local arrays c ------------ ! integer ja,jl,jk real zt_co2 (ndlon,nuco2) real zt_aer (ndlon,nuco2) --- 58,64 ---- c 0.2 local arrays c ------------ ! integer ja,jl,jk,ig0 real zt_co2 (ndlon,nuco2) real zt_aer (ndlon,nuco2) *************** *** 170,181 **** ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk) . - trans_emis(jl,ja,jk+1) ! xi(jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) . + ksi_emis(jl,ja,jk)* (1 - emis(jl)) c ksi Reciprocity c --------------- ! xi(jl,ja,nlaylte+1,jk) = xi(jl,ja,jk,nlaylte+1) c------------------------------------------------------------------------- c 2.2 echange with ground (from "layer" 0 toward layers 1,nlaylte) --- 170,181 ---- ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk) . - trans_emis(jl,ja,jk+1) ! xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk) . + ksi_emis(jl,ja,jk)* (1 - emis(jl)) c ksi Reciprocity c --------------- ! xi(ig0+jl,ja,nlaylte+1,jk) = xi(ig0+jl,ja,jk,nlaylte+1) c------------------------------------------------------------------------- c 2.2 echange with ground (from "layer" 0 toward layers 1,nlaylte) *************** *** 185,195 **** ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) . - trans(jl,ja,1,jk+1) ! xi(jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl) c ksi Reciprocity c --------------- ! xi(jl,ja,jk,0) = xi(jl,ja,0,jk) c------------------------------------------------------------------------- enddo --- 185,195 ---- ksi(jl,ja,1,jk) = trans(jl,ja,1,jk) . - trans(jl,ja,1,jk+1) ! xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl) c ksi Reciprocity c --------------- ! xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk) c------------------------------------------------------------------------- enddo *************** *** 206,216 **** do jl = 1 , kdlon ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) ! xi(jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl) c ksi Reciprocity c --------------- ! xi(jl,ja,nlaylte+1,0) = xi(jl,ja,0,nlaylte+1) enddo enddo --- 206,216 ---- do jl = 1 , kdlon ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1) ! xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl) c ksi Reciprocity c --------------- ! xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1) enddo enddo diff --ignore-blank-lines --context=3 -r oldgcm/lwxd.F oldmeso/lwxd.F *** oldgcm/lwxd.F Tue Feb 2 15:41:20 2010 --- oldmeso/lwxd.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! subroutine lwxd (kdlon,kflev,emis . ,aer_t,co2_u,co2_up) c---------------------------------------------------------------------- --- 1,4 ---- ! subroutine lwxd (ig0,kdlon,kflev,emis . ,aer_t,co2_u,co2_up) c---------------------------------------------------------------------- *************** *** 45,50 **** --- 45,51 ---- c --------- c inputs: c ------- + integer ig0 integer kdlon ! part of ngrid integer kflev ! part of nalyer *************** *** 218,231 **** c print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk) c endif ! xi(jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk) . + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl)) c ksi reciprocity c --------------- ksi(jl,ja,jkk,jk) = ksi(jl,ja,jk,jkk) ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk) ! xi(jl,ja,jkk,jk) = xi(jl,ja,jk,jkk) enddo enddo --- 219,232 ---- c print*,'ksi_emis bande',ja,jk,jkk,ksi_emis(jl,ja,jk,jkk) c endif ! xi(ig0+jl,ja,jk,jkk) = ksi(jl,ja,jk,jkk) . + ksi_emis(jl,ja,jk,jkk) * (1 - emis(jl)) c ksi reciprocity c --------------- ksi(jl,ja,jkk,jk) = ksi(jl,ja,jk,jkk) ksi_emis(jl,ja,jkk,jk) = ksi_emis(jl,ja,jk,jkk) ! xi(ig0+jl,ja,jkk,jk) = xi(ig0+jl,ja,jk,jkk) enddo enddo *************** *** 244,250 **** c . trans_emis(jl,ja,jk,jk+1) - trans_emis(jl,ja,jk+1,jk+1) c . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2) ! xi_emis(jl,ja,jk) = . ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl)) enddo --- 245,251 ---- c . trans_emis(jl,ja,jk,jk+1) - trans_emis(jl,ja,jk+1,jk+1) c . - trans_emis(jl,ja,jk,jk+2) + trans_emis(jl,ja,jk+1,jk+2) ! xi_emis(ig0+jl,ja,jk) = . ksi_emis(jl,ja,jk,jk+1) * (1-emis(jl)) enddo diff --ignore-blank-lines --context=3 -r oldgcm/lwxn.F oldmeso/lwxn.F *** oldgcm/lwxn.F Tue Feb 2 15:41:20 2010 --- oldmeso/lwxn.F Tue Jan 25 16:49:09 2011 *************** *** 1,4 **** ! subroutine lwxn ( kdlon,kflev . , dp . , aer_t,co2_u,co2_up) --- 1,4 ---- ! subroutine lwxn ( ig0,kdlon,kflev . , dp . , aer_t,co2_u,co2_up) *************** *** 83,88 **** --- 83,89 ---- c --------- c inputs: c ------- + integer ig0 integer kdlon ! part of ngrid integer kflev ! part of nalyer *************** *** 342,353 **** do ja = 1 ,nuco2 do jl = 1 , kdlon ! xi(jl,ja,jk,jk+1) = ksi(jl,ja,jk) ! . + xi_emis(jl,ja,jk) c ksi reciprocity c --------------- ! xi(jl,ja,jk+1,jk) = xi(jl,ja,jk,jk+1) enddo enddo --- 343,354 ---- do ja = 1 ,nuco2 do jl = 1 , kdlon ! xi(ig0+jl,ja,jk,jk+1) = ksi(jl,ja,jk) ! . + xi_emis(ig0+jl,ja,jk) c ksi reciprocity c --------------- ! xi(ig0+jl,ja,jk+1,jk) = xi(ig0+jl,ja,jk,jk+1) enddo enddo *************** *** 360,366 **** do ja = 1 ,nuco2 do jl = 1 , kdlon ! xi_ground(jl,ja)=0. enddo enddo --- 361,367 ---- do ja = 1 ,nuco2 do jl = 1 , kdlon ! xi_ground(ig0+jl,ja)=0. enddo enddo *************** *** 368,374 **** do ja = 1 ,nuco2 do jl = 1 , kdlon ! xi_ground(jl,ja) = xi_ground(jl,ja) . + ( trans(jl,ja,ni+1,ncouche+1) . -trans(jl,ja,ni,ncouche+1)) . * 2 * cb(ni) --- 369,375 ---- 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)) . * 2 * cb(ni) Only in oldmeso: meso_dimphys.h_ref Only in oldmeso: meso_dustlift Only in oldmeso: meso_inifis.F Only in oldmeso: meso_inifis.F~ Only in oldmeso: meso_newcondens Only in oldmeso: meso_physiq.F Only in oldmeso: meso_physiq.F~ Only in oldmeso: meso_testphys1d.F diff --ignore-blank-lines --context=3 -r oldgcm/newcondens.F oldmeso/newcondens.F *** oldgcm/newcondens.F Tue Feb 2 15:41:20 2010 --- oldmeso/newcondens.F Tue Jan 25 16:49:10 2011 *************** *** 423,429 **** piceco2(ig)=0. endif ENDDO ! ! Set albedo and emissivity of the surface ! ---------------------------------------- CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref) --- 423,429 ---- piceco2(ig)=0. endif ENDDO ! ! Set albedo and emissivity of the surface ! ---------------------------------------- CALL albedocaps(zls,ngrid,piceco2,psolaralb,emisref) *************** *** 589,618 **** do iq=1,nqmx zqm(nlayer+1,iq)= zq(nlayer,iq) enddo - - c Tendencies on T, U, V, Q - c """""""""""""""""""""""" - DO l=1,nlayer ! c Tendencies on T ! zdtsig(ig,l) = (1/masse(l)) * ! & ( zmflux(l)*(ztm(l) - ztc(l)) ! & - zmflux(l+1)*(ztm(l+1) - ztc(l)) ! & + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l)) ) ! pdtc(ig,l) = pdtc(ig,l) + zdtsig(ig,l) ! ! c Tendencies on U ! pduc(ig,l) = (1/masse(l)) * ! & ( zmflux(l)*(zum(l) - zu(l)) ! & - zmflux(l+1)*(zum(l+1) - zu(l)) ) ! ! ! c Tendencies on V ! pdvc(ig,l) = (1/masse(l)) * ! & ( zmflux(l)*(zvm(l) - zv(l)) ! & - zmflux(l+1)*(zvm(l+1) - zv(l)) ) ! ! END DO c Tendencies on Q do iq=1,nqmx --- 589,622 ---- do iq=1,nqmx zqm(nlayer+1,iq)= zq(nlayer,iq) enddo ! CCCC ! CCCC *** WRF comments ! CCCC ! c ! cc Tendencies on T, U, V, Q ! cc """""""""""""""""""""""" ! c DO l=1,nlayer ! c ! cc Tendencies on T ! c zdtsig(ig,l) = (1/masse(l)) * ! c & ( zmflux(l)*(ztm(l) - ztc(l)) ! c & - zmflux(l+1)*(ztm(l+1) - ztc(l)) ! c & + zcondicea(ig,l)*(ztcond(ig,l)-ztc(l)) ) ! c pdtc(ig,l) = pdtc(ig,l) + zdtsig(ig,l) ! c ! cc Tendencies on U ! c pduc(ig,l) = (1/masse(l)) * ! c & ( zmflux(l)*(zum(l) - zu(l)) ! c & - zmflux(l+1)*(zum(l+1) - zu(l)) ) ! c ! c ! cc Tendencies on V ! c pdvc(ig,l) = (1/masse(l)) * ! c & ( zmflux(l)*(zvm(l) - zv(l)) ! c & - zmflux(l+1)*(zvm(l+1) - zv(l)) ) ! c ! c END DO c Tendencies on Q do iq=1,nqmx Only in oldgcm: newcondens.F.old Only in oldmeso: newcondens.F~ Only in oldmeso: nocompile Only in oldgcm: orodrag.F Only in oldgcm: orosetup.F Only in oldmeso: param_slope.F90 Only in oldmeso: param_slope_full.F90 Only in oldgcm: physdem1.F Only in oldgcm: physiq.F Only in oldgcm: physiq.F.old Only in oldgcm: physiq.F~ Only in oldgcm: readtesassim.F90.old Only in oldmeso: slope.h Only in oldmeso: splitting Only in oldmeso: splitting.tar.gz diff --ignore-blank-lines --context=3 -r oldgcm/suaer.F90 oldmeso/suaer.F90 *** oldgcm/suaer.F90 Tue Feb 2 15:41:20 2010 --- oldmeso/suaer.F90 Tue Jan 25 16:49:09 2011 *************** *** 88,103 **** !---- Please indicate the names of the optical property files below ! Please also choose the reference wavelengths of each aerosol ! naerkind=1, visible range: ! ! file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff ! file_id(1,1) = 'optprop_dustvis_TM.dat' !M.Wolff TM ! ! file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE ! file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell ! ! file_id(1,1) = 'optprop_dustvis.dat' !Clancy-Lee ! naerkind=1, infrared: ! file_id(1,2) = 'optprop_dustir_TM_n50.dat' !M.Wolff ! file_id(1,2) = 'optprop_dustir_TM.dat' !M.Wolff ! file_id(1,2) = 'optprop_dustir_MW-MIE.dat' !M.Wolff MIE ! ! file_id(1,2) = 'optprop_dustir_x0.5.dat' !Toon-Forget ! naerkind=1, visible range: longrefvis(1)=0.67E-6 ! For dust: change readtesassim accordingly; --- 88,103 ---- !---- Please indicate the names of the optical property files below ! Please also choose the reference wavelengths of each aerosol ! naerkind=1, visible range: ! ! file_id(1,1) = 'optprop_dustvis_TM_n50.dat' !M.Wolff !!***WRF: pour faire varier le rayon (experim) ! file_id(1,1) = 'optprop_dustvis_TM.dat' !M.Wolff TM !!***WRF: PAR DEFAUT ! ! file_id(1,1) = 'optprop_dustvis_MW-MIE.dat' !M.Wolff MIE !!***WRF: pour test JB ! file_id(1,1) = 'optprop_dustvis_ockert.dat' !Ockert-Bell ! ! file_id(1,1) = 'optprop_dustvis.dat' !Clancy-Lee ! naerkind=1, infrared: ! file_id(1,2) = 'optprop_dustir_TM_n50.dat' !M.Wolff ! file_id(1,2) = 'optprop_dustir_TM.dat' !M.Wolff ! file_id(1,2) = 'optprop_dustir_MW-MIE.dat' !M.Wolff MIE ! ! file_id(1,2) = 'optprop_dustir_x0.5.dat' !Toon-Forget ! naerkind=1, visible range: longrefvis(1)=0.67E-6 ! For dust: change readtesassim accordingly; Only in oldgcm: suaer.F90.old Only in oldgcm: sugwd.F diff --ignore-blank-lines --context=3 -r oldgcm/surfdat.h oldmeso/surfdat.h *** oldgcm/surfdat.h Tue Feb 2 15:41:20 2010 --- oldmeso/surfdat.h Tue Jan 25 16:49:10 2011 *************** *** 8,13 **** --- 8,15 ---- COMMON/surfdatl/TESicealbedo real albedodat ! albedo of bare ground + ! Ehouarn: moved inertiedat to comsoil.h + ! real inertiedat, ! thermal inertia real phisfi ! geopotential at ground level real albedice ! default albedo for ice (1: North H. 2: South H.) real emisice ! ice emissivity; 1:Northern hemisphere 2:Southern hemisphere Only in oldgcm: surfdat.h.old Only in oldmeso: surfdat.h~ diff --ignore-blank-lines --context=3 -r oldgcm/swmain.F oldmeso/swmain.F *** oldgcm/swmain.F Tue Feb 2 15:41:20 2010 --- oldmeso/swmain.F Tue Jan 25 16:49:09 2011 *************** *** 72,80 **** REAL PFRACT(NDLO2) real PFLUXD(NDLON,NFLEV+1,2) real PFLUXU(NDLON,NFLEV+1,2) ! REAL :: QVISsQREF3d(ngridmx,nlayermx,nsun,naerkind) ! REAL :: omegaVIS3d(ngridmx,nlayermx,nsun,naerkind) ! REAL :: gVIS3d(ngridmx,nlayermx,nsun,naerkind) C LOCAL ARRAYS C ------------ --- 72,80 ---- REAL PFRACT(NDLO2) real PFLUXD(NDLON,NFLEV+1,2) real PFLUXU(NDLON,NFLEV+1,2) ! REAL :: QVISsQREF3d(NDLO2,KFLEV,nsun,naerkind) ! REAL :: omegaVIS3d(NDLO2,KFLEV,nsun,naerkind) ! REAL :: gVIS3d(NDLO2,KFLEV,nsun,naerkind) C LOCAL ARRAYS C ------------ diff --ignore-blank-lines --context=3 -r oldgcm/swr_toon.F oldmeso/swr_toon.F *** oldgcm/swr_toon.F Tue Feb 2 15:41:20 2010 --- oldmeso/swr_toon.F Tue Jan 25 16:49:10 2011 *************** *** 253,267 **** c FM = flux down C PRIVATES: INTEGER J,NL,NLEV ! PARAMETER (NL=201) ! C THIS VALUE (201) MUST BE .GE. 2*NAYER REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4 ! REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL) ! REAL*8 LAMDA(NL),XK1(NL),XK2(NL) ! REAL*8 G1(NL),G2(NL),G3(NL) ! REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL) ! REAL*8 E1(NL),E2(NL),E3(NL),E4(NL) ! NLEV = NAYER+1 C TURN ON THE DELTA-FUNCTION IF REQUIRED HERE --- 253,277 ---- c FM = flux down C PRIVATES: INTEGER J,NL,NLEV ! !!!! AS+JBM 03/2010 BUG BUG si trop niveaux verticaux (LES) ! !!!! ET PAS BESOIN DE HARDWIRE SALE ICI ! ! !!!! CORRIGER CE BUG AMELIORE EFFICACITE ET FLEXIBILITE ! !! PARAMETER (NL=201) ! !! C THIS VALUE (201) MUST BE .GE. 2*NAYER REAL*8 BSURF,AP,AM,DENOM,EM,EP,G4 ! !! REAL*8 W0(NL), COSBAR(NL), DTAU(NL), TAU(NL) ! !! REAL*8 LAMDA(NL),XK1(NL),XK2(NL) ! !! REAL*8 G1(NL),G2(NL),G3(NL) ! !! REAL*8 GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL) ! !! REAL*8 E1(NL),E2(NL),E3(NL),E4(NL) ! REAL*8 W0(2*NAYER), COSBAR(2*NAYER), DTAU(2*NAYER), TAU(2*NAYER) ! REAL*8 LAMDA(2*NAYER),XK1(2*NAYER),XK2(2*NAYER) ! REAL*8 G1(2*NAYER),G2(2*NAYER),G3(2*NAYER) ! REAL*8 GAMA(2*NAYER),CP(2*NAYER),CM(2*NAYER),CPM1(2*NAYER) ! REAL*8 CMM1(2*NAYER) ! REAL*8 E1(2*NAYER),E2(2*NAYER),E3(2*NAYER),E4(2*NAYER) ! ! NL = 2*NAYER !!! AS+JBM 03/2010 NLEV = NAYER+1 C TURN ON THE DELTA-FUNCTION IF REQUIRED HERE *************** *** 381,391 **** C DOUBLE PRECISION VERSION OF SOLVER ! PARAMETER (NMAX=201) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION GAMA(NL),CP(NL),CM(NL),CPM1(NL),CMM1(NL),XK1(NL), * XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL) ! DIMENSION AF(NMAX),BF(NMAX),CF(NMAX),DF(NMAX),XK(NMAX) C********************************************************* C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE * C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS * --- 391,405 ---- C DOUBLE PRECISION VERSION OF SOLVER ! 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), * XK2(NL),E1(NL),E2(NL),E3(NL),E4(NL) ! 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) ! C********************************************************* C* THIS SUBROUTINE SOLVES FOR THE COEFFICIENTS OF THE * C* TWO STREAM SOLUTION FOR GENERAL BOUNDARY CONDITIONS * *************** *** 481,490 **** C DOUBLE PRECISION VERSION OF TRIDGL ! PARAMETER (NMAX=201) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION AF(L),BF(L),CF(L),DF(L),XK(L) ! DIMENSION AS(NMAX),DS(NMAX) C* THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX C* EQUATIONS. THE FORM OF THE EQUATIONS ARE: --- 495,507 ---- C DOUBLE PRECISION VERSION OF TRIDGL ! 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) ! cc AS+JBM 03/2010 : OBSOLETE MAINTENANT ! cc DIMENSION AS(NMAX),DS(NMAX) ! DIMENSION AS(L),DS(L) C* THIS SUBROUTINE SOLVES A SYSTEM OF TRIDIAGIONAL MATRIX C* EQUATIONS. THE FORM OF THE EQUATIONS ARE: Only in oldgcm: testphys1d.F Only in oldmeso: ye Only in oldmeso: yeye