Index: trunk/LMDZ.MARS/libf/phymars/comg1d.h =================================================================== --- trunk/LMDZ.MARS/libf/phymars/comg1d.h (revision 3003) +++ (revision ) @@ -1,65 +1,0 @@ -c....................................................................... -c le COMMON pour GRADS-1D -c (Utilise pour les sorties format Grads dans la version 1D du modele) -c -c on peut se dire : "on ne sauvera pas plus de 1000 variables ... hein ?" -c - INTEGER g1d_nvarmx - PARAMETER(g1d_nvarmx=1000) -c -c * g1d_nlayer ---> nombre de couches verticales -c * g1d_nomfich ---> nom du fichier grads -c * g1d_unitfich ---> code du fichier grads -c * g1d_nomctl ---> nom du fichier ctl -c * g1d_unitctl ---> code du fichier ctl -c * g1d_premier ---> variable logique pour dire si le fichier -c est deja ouvert -c * g1d_irec ---> indice de derniere ecriture -c * g1d_nvar ---> nombre de variables deja definies a la -c derniere ecriture -c * g1d_nomvar ---> noms des vecteurs existants -c * g1d_dimvar ---> taille des vecteurs -c * g1d_titrevar ---> titres des vecteurs -c * g1d_tmp1 ---> caractere -c * g1d_tmp2 ---> caractere -c - INTEGER g1d_nlayer - CHARACTER*100 g1d_nomfich - INTEGER g1d_unitfich - CHARACTER*100 g1d_nomctl - INTEGER g1d_unitctl - LOGICAL g1d_premier - LOGICAL g2d_premier - INTEGER g1d_irec - INTEGER g2d_irec - INTEGER g2d_appel - INTEGER g1d_nvar - CHARACTER*100 g1d_nomvar - INTEGER g1d_dimvar - CHARACTER*100 g1d_titrevar - CHARACTER*100 g1d_tmp1,g1d_tmp2 -c - COMMON/COMG1DI/g1d_nlayer - & ,g1d_unitfich - & ,g1d_unitctl - & ,g1d_irec - & ,g2d_irec - & ,g2d_appel - & ,g1d_nvar -!$OMP THREADPRIVATE(/COMG1DI/) - - COMMON/COMG1DC/g1d_dimvar(0:g1d_nvarmx) - & ,g1d_nomfich - & ,g1d_nomctl - & ,g1d_nomvar(0:g1d_nvarmx) - & ,g1d_titrevar(0:g1d_nvarmx) - & ,g1d_tmp1 - & ,g1d_tmp2 -!$OMP THREADPRIVATE(/COMG1DC/) - - COMMON/COMG1DL/g1d_premier - & ,g2d_premier -!$OMP THREADPRIVATE(/COMG1DL/) - -c -c....................................................................... Index: trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F (revision 3003) +++ trunk/LMDZ.MARS/libf/phymars/dyn1d/testphys1d.F (revision 3004) @@ -81,5 +81,4 @@ !#include "control.h" include "netcdf.inc" - include "comg1d.h" !#include "advtrac.h" @@ -829,17 +828,4 @@ endif - -c Initialization for GRADS outputs in "g1d.dat" and "g1d.ctl" -c ---------------------------------------------------------------- -c (output done in "writeg1d", typically called by "physiq.F") - - g1d_nlayer=nlayer - g1d_nomfich='g1d.dat' - g1d_unitfich=40 - g1d_nomctl='g1d.ctl' - g1d_unitctl=41 - g1d_premier=.true. - g2d_premier=.true. - c Write a "startfi" file c -------------------- @@ -994,13 +980,4 @@ ENDIF -c ======================================================== -c OUTPUTS -c ======================================================== - -c finalize and close grads files "g1d.dat" and "g1d.ctl" - -c CALL endg1d(1,nlayer,zphi/(g*1000.),ndt) - CALL endg1d(1,nlayer,zlay/1000.,ndt) - write(*,*) "testphys1d: Everything is cool." Index: trunk/LMDZ.MARS/libf/phymars/lwflux.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/lwflux.F (revision 3003) +++ trunk/LMDZ.MARS/libf/phymars/lwflux.F (revision 3004) @@ -1,3 +1,9 @@ - subroutine lwflux (ig0,kdlon,kflev,dp + module lwflux_mod + + implicit none + + contains + + subroutine lwflux (ig0,kdlon,kflev,dp . ,bsurf,btop,blev,blay,dbsublay . ,tlay, tlev, dt0 ! pour sortie dans g2d uniquement @@ -16,5 +22,4 @@ include "callkeys.h" - include "comg1d.h" c---------------------------------------------------------------------- @@ -347,159 +352,7 @@ end do end do - END IF - -c---------------------------------------------------------------------- -c 7.0 outputs Grads 2D -c ---------------- - -c ig1d: point de la grille physique ou on veut faire la sortie -c ig0+1: point du decoupage de la grille physique - - if (callg2d) then - - ig1d = kdlon/2 + 1 -c ig1d = kdlon - - if ((ig0+1).LE.ig1d .and. ig1d.LE.(ig0+kdlon) - . .OR. kdlon.EQ.1 ) then - - ig = ig1d-ig0 - print*, 'Sortie g2d: ig1d, ig, ig0', ig1d, ig, ig0 - -c-------------------------------------------- -c Ouverture de g2d.dat -c-------------------------------------------- - if (g2d_premier) then - open (47,file='g2d.dat' -clmd & ,form='unformatted',access='direct',recl=4) - & ,form='unformatted',access='direct',recl=1 - & ,status='unknown') - g2d_irec=0 - g2d_appel=0 - g2d_premier=.false. - endif - g2d_appel = g2d_appel+1 - -c-------------------------------------------- -c Sortie g2d des xi proches + distants -c-------------------------------------------- -cl if (nflev .NE. 500) then - do ja = 1,nuco2 - do j = 0,nlaylte+1 - do i = 0,nlaylte+1 - g2d_irec=g2d_irec+1 - reel4 = xi(ig1d,ja,i,j) - write(47,rec=g2d_irec) reel4 - enddo - enddo - enddo -cl endif - -c------------------------------------------------------ -c Writeg2d des ksidb -c------------------------------------------------------ - do ja = 1,nuco2 -c ja=1 - 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 - enddo - - 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 - -c------------------------------------------------------ -c Writeg2d dpsgcp -c------------------------------------------------------ - - do j = 1 , nlaylte - do i = 0 , nlaylte+1 - dpsgcp(i,j) = dp(ig,j) / gcp - enddo - enddo - - do i = 0 , nlaylte+1 -c dpsgcp(i,0) = 0.0002 ! (rapport ~ entre 1000 et 10000 pour le sol) - dpsgcp(i,0) = 1. ! (pour regler l'echelle des sorties) - dpsgcp(i,nlaylte+1) = 0. - enddo - -c print* -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 -c print*,i,'dpsgcp: ',dpsgcp(i,1) -c enddo - - do j = 0,nlaylte+1 - do i = 0,nlaylte+1 - g2d_irec=g2d_irec+1 - reel4 = dpsgcp(i,j) - write(47,rec=g2d_irec) reel4 - enddo - enddo - -c------------------------------------------------------ -c Writeg2d temperature -c------------------------------------------------------ - - 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 - - do j = 0,nlaylte+1 - do i = 0,nlaylte+1 - g2d_irec=g2d_irec+1 - reel4 = temp(i,j) - write(47,rec=g2d_irec) reel4 - 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************************************************************************ - endif ! callg2d - - end + END IF ! of IF (computeflux) + + end subroutine lwflux + + end module lwflux_mod Index: trunk/LMDZ.MARS/libf/phymars/lwi.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/lwi.F (revision 3003) +++ trunk/LMDZ.MARS/libf/phymars/lwi.F (revision 3004) @@ -1,2 +1,8 @@ + module lwi_mod + + implicit none + + contains + subroutine lwi (ig0,kdlon,kflev . ,psi,zdblay,pdp @@ -10,6 +16,5 @@ implicit none -#include "comg1d.h" -#include "callkeys.h" + include "callkeys.h" CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -33,12 +38,13 @@ c - integer ig0,kdlon,kflev - - real psi(ndlo2,kflev) - . , zdblay(ndlo2,nir,kflev) - . , pdp(ndlo2,kflev) - - - real newpcolc(ndlo2,kflev) + integer,intent(in) :: ig0 + integer,intent(in) :: kdlon + integer,intent(in) :: kflev + + real,intent(in) :: psi(ndlo2,kflev) + real,intent(in) :: zdblay(ndlo2,nir,kflev) + real,intent(in) :: pdp(ndlo2,kflev) + + real,intent(out) :: newpcolc(ndlo2,kflev) c------------------------------------------------------------------------- @@ -215,4 +221,6 @@ c------------------------------------------------------------------------- - RETURN - END + + end subroutine lwi + + end module lwi_mod Index: trunk/LMDZ.MARS/libf/phymars/lwmain_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/lwmain_mod.F (revision 3003) +++ trunk/LMDZ.MARS/libf/phymars/lwmain_mod.F (revision 3004) @@ -21,4 +21,7 @@ use dimradmars_mod, only: naerkind use yomlw_h, only: nlaylte, xi + use lwi_mod, only: lwi + use lwflux_mod, only: lwflux + implicit none @@ -26,5 +29,4 @@ c ------------- include "callkeys.h" - include "comg1d.h" c---------------------------------------------------------------------- Index: trunk/LMDZ.MARS/libf/phymars/physiq_mod.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/physiq_mod.F (revision 3003) +++ trunk/LMDZ.MARS/libf/phymars/physiq_mod.F (revision 3004) @@ -213,5 +213,4 @@ include "callkeys.h" - include "comg1d.h" include "nlteparams.h" include "netcdf.inc" Index: trunk/LMDZ.MARS/libf/phymars/writeg1d.F =================================================================== --- trunk/LMDZ.MARS/libf/phymars/writeg1d.F (revision 3003) +++ (revision ) @@ -1,204 +1,0 @@ - SUBROUTINE writeg1d(ngrid,nx,x,nom,titre) - IMPLICIT NONE -c....................................................................... -c -c ecriture de x pour GRADS-1D -c -c in : -c * ngrid ---> pour controler que l'on est bien en 1D -c * nx ---> taille du vecteur a stocker -c "1" pour une variable de surface -c "nlayer" pour une variable de centre de couche -c "nlayer+1" pour une variable d'interface -c * x ---> variable a stocker -c * nom ---> nom "pour grads" -c * titre ---> titre "pour grads" -c -c....................................................................... -c -#include "comg1d.h" - -c -c....................................................................... -c declaration des arguments -c - INTEGER ngrid,nx,i - REAL*4 xr4(1000) - REAL x(nx) - CHARACTER*(*) nom,titre -c -c declaration des arguments -c....................................................................... -c declaration des variables locales -c - INTEGER ilayer,ivar - LOGICAL test -c -c declaration des variables locales -c....................................................................... -c controle 1D -c -c print*,'ngrid=',ngrid - IF (ngrid.NE.1) return -c -c controle 1D -c....................................................................... -c copy => force en reel 4 pour l'ecriture dans grads1d.dat - - do i=1,nx - xr4(i) = x(i) - enddo - -c copy => force en reel 4 pour l'ecriture dans grads1d.dat -c....................................................................... -c ouverture du fichier au premier appel -c - IF (g1d_premier) THEN - OPEN (g1d_unitfich,FILE=g1d_nomfich - & ,FORM='unformatted',ACCESS='direct',RECL=4) - g1d_irec=0 - g1d_nvar=0 - g1d_premier=.false. - ENDIF -c -c ouverture du fichier au premier appel -c....................................................................... -c pour l'ecriture du fichier ctl -c - test=.true. - DO ivar=1,g1d_nvar - IF (nom.EQ.g1d_nomvar(ivar)) test=.false. - IF (nx .GT. 1000) then - print*,'ERROR: nx > 1000 dans writeg1d.F' - print*,'Changer la dimension de xr4' - call exit(1) - ENDIF - ENDDO - IF (test) THEN - g1d_nvar=g1d_nvar+1 - g1d_nomvar(g1d_nvar)=nom - g1d_titrevar(g1d_nvar)=titre - IF (nx.EQ.1) THEN - g1d_dimvar(g1d_nvar)=0 - ELSEIF (nx.EQ.g1d_nlayer) THEN - g1d_dimvar(g1d_nvar)=g1d_nlayer - ELSEIF (nx.EQ.g1d_nlayer+1) THEN - g1d_dimvar(g1d_nvar)=g1d_nlayer+1 - ELSE - PRINT *,'._. probleme de dimension dans GRADS-1D ._.' - print*,'NX = ',nx - print*,'g1d_nlayer = ',g1d_nlayer - ENDIF - ENDIF -c -c pour l'ecriture du fichier ctl -c....................................................................... -c ecriture -c - IF (nx.EQ.1) THEN - g1d_irec=g1d_irec+1 - WRITE(g1d_unitfich,REC=g1d_irec) xr4(1) - ELSE - DO ilayer=1,nx - g1d_irec=g1d_irec+1 - WRITE(g1d_unitfich,REC=g1d_irec) xr4(ilayer) - ENDDO - ENDIF -c -c ecriture -c....................................................................... -c -10001 CONTINUE -c -c....................................................................... -c - RETURN - END - - - - - -c ********************************************************************* -c ********************************************************************* - - SUBROUTINE endg1d(ngrid,nlayer,zlayer,ndt) - USE time_phylmdz_mod, ONLY: dtphys, daysec - IMPLICIT NONE -c....................................................................... -c -c ecriture du fichier de controle pour GRADS-1D -c -c in : -c * ngrid ---> pour controler que l'on est bien en 1D -c * nlayer ---> nombre de couches -c * zlayer ---> altitude au centre de chaque couche (km) -c * ndt ---> nombre de pas de temps -c -c....................................................................... -c -#include "comg1d.h" -c -c....................................................................... -c declaration des arguments -c - INTEGER ngrid,nlayer - REAL zlayer(nlayer) - INTEGER ndt -c -c declaration des arguments -c....................................................................... -c declaration des variables locales -c - INTEGER ivar,ilayer -c -c declaration des variables locales -c....................................................................... -c contole 1D -c - IF (ngrid.NE.1) GOTO 10001 -c -c contole 1D -c....................................................................... -c - IF (nlayer.ne.g1d_nlayer) - &PRINT *,'._. probleme de dimension dans GRADS-1D (endg1d.F) ' -c -c....................................................................... -c - CLOSE (g1d_unitfich) -c -c....................................................................... -c - OPEN (g1d_unitctl,FILE=g1d_nomctl,FORM='formatted',RECL=4*100) - WRITE (g1d_unitctl,'(a4,2x,a1,a20)') 'DSET','^',g1d_nomfich - WRITE (g1d_unitctl,'(a5,2x,a20)') 'UNDEF ','1.E+30' - WRITE (g1d_unitctl,'(a11)') 'FORMAT YREV' - WRITE (g1d_unitctl,'(a5,2x,a30)') 'TITLE ','champs 1D' - WRITE (g1d_unitctl,'(a5,i4,a20)') 'XDEF ',1,' LINEAR 0 1' - WRITE (g1d_unitctl,'(a5,i4,a20)') 'YDEF ',1,' LINEAR 0 1' - WRITE (g1d_unitctl,'(a5,i4,a20)') 'ZDEF ',g1d_nlayer,' LEVELS' - WRITE (g1d_unitctl,'(5(1x,f13.5))') - & (zlayer(ilayer),ilayer=1,g1d_nlayer) - -c Writing true timestep in g1d.ctl (in planet "minutes"= sol/(60*24) - ivar =min( max(int(1440.*dtphys/daysec +0.5),1) , 99) - WRITE (g1d_unitctl,'(a4,2x,i10,a19,i2,a2)') - & 'TDEF ',ndt,' LINEAR 01JAN2000 ', ivar,'MN ' - - WRITE (g1d_unitctl,'(a5,i5)') 'VARS ',g1d_nvar - DO ivar=1,g1d_nvar - WRITE (g1d_unitctl,'(a9,3x,i4,i3,1x,a39)') - & g1d_nomvar(ivar),g1d_dimvar(ivar),99,g1d_titrevar(ivar) - ENDDO - WRITE (g1d_unitctl,'(a7)') 'ENDVARS' - CLOSE (g1d_unitctl) -c -c....................................................................... -c -10001 CONTINUE -c -c....................................................................... -c - RETURN - END