Index: LMDZ5/branches/testing/libf/bibio/initdynav.F =================================================================== --- LMDZ5/branches/testing/libf/bibio/initdynav.F (revision 1663) +++ (revision ) @@ -1,200 +1,0 @@ -! -! $Id$ -! - subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt) - -#ifdef CPP_IOIPSL - USE IOIPSL -#endif - USE infotrac, ONLY : nqtot, ttext - use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, & - & dynhistave_file,dynhistvave_file,dynhistuave_file - implicit none - -C -C Routine d'initialisation des ecritures des fichiers histoires LMDZ -C au format IOIPSL. Initialisation du fichier histoire moyenne. -C -C Appels succesifs des routines: histbeg -C histhori -C histver -C histdef -C histend -C -C Entree: -C -C infile: nom du fichier histoire a creer -C day0,anne0: date de reference -C tstep : frequence d'ecriture -C t_ops: frequence de l'operation pour IOIPSL -C t_wrt: frequence d'ecriture sur le fichier -C -C -C L. Fairhead, LMD, 03/99 -C -C ===================================================================== -C -C Declarations -#include "dimensions.h" -#include "paramet.h" -#include "comconst.h" -#include "comvert.h" -#include "comgeom.h" -#include "temps.h" -#include "ener.h" -#include "logic.h" -#include "description.h" -#include "serre.h" -#include "iniprint.h" - -C Arguments -C - integer day0, anne0 - real tstep, t_ops, t_wrt - -#ifdef CPP_IOIPSL -! This routine needs IOIPSL to work -C Variables locales -C - integer tau0 - real zjulian - integer iq - real rlong(iip1,jjp1), rlat(iip1,jjp1) - integer uhoriid, vhoriid, thoriid, zvertiid - integer ii,jj - integer zan, dayref -C -C Initialisations -C - pi = 4. * atan (1.) -C -C Appel a histbeg: creation du fichier netcdf et initialisations diverses -C - - zan = anne0 - dayref = day0 - CALL ymds2ju(zan, 1, dayref, 0.0, zjulian) - tau0 = itau_dyn - - do jj = 1, jjp1 - do ii = 1, iip1 - rlong(ii,jj) = rlonv(ii) * 180. / pi - rlat(ii,jj) = rlatu(jj) * 180. / pi - enddo - enddo - -! Creation de 3 fichiers pour les differentes grilles horizontales -! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier -! Grille Scalaire - call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), - . 1, iip1, 1, jjp1, - . tau0, zjulian, tstep, thoriid,histaveid) - -C Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant, -C IOIPSL ne permet pas de grilles avec des nombres de point differents dans -C un meme fichier) -! Grille V - do jj = 1, jjm - do ii = 1, iip1 - rlong(ii,jj) = rlonv(ii) * 180. / pi - rlat(ii,jj) = rlatv(jj) * 180. / pi - enddo - enddo - - call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:), - . 1, iip1, 1, jjm, - . tau0, zjulian, tstep, vhoriid,histvaveid) -! Grille U - do jj = 1, jjp1 - do ii = 1, iip1 - rlong(ii,jj) = rlonu(ii) * 180. / pi - rlat(ii,jj) = rlatu(jj) * 180. / pi - enddo - enddo - - call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:), - . 1, iip1, 1, jjp1, - . tau0, zjulian, tstep, uhoriid,histuaveid) -C -C Appel a histvert pour la grille verticale -C - call histvert(histaveid,'presnivs','Niveaux Pression - & approximatifs','mb',llm, presnivs/100., zvertiid,'down') - call histvert(histuaveid,'presnivs','Niveaux Pression - & approximatifs','mb',llm, presnivs/100., zvertiid,'down') - call histvert(histvaveid,'presnivs','Niveaux Pression - & approximatifs','mb',llm, presnivs/100., zvertiid,'down') -C -C Appels a histdef pour la definition des variables a sauvegarder -C -C Vents U -C -! write(6,*)'inithistave',tstep - call histdef(histuaveid, 'u', 'vent u moyen ', - . 'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, - . 32, 'ave(X)', t_ops, t_wrt) - -C Vents V -C - call histdef(histvaveid, 'v', 'vent v moyen', - . 'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid, - . 32, 'ave(X)', t_ops, t_wrt) - -C -C Temperature -C - call histdef(histaveid, 'temp', 'temperature moyenne', 'K', - . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, - . 32, 'ave(X)', t_ops, t_wrt) -C -C Temperature potentielle -C - call histdef(histaveid, 'theta', 'temperature potentielle', 'K', - . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, - . 32, 'ave(X)', t_ops, t_wrt) -C -C Geopotentiel -C - call histdef(histaveid, 'phi', 'geopotentiel moyen', '-', - . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, - . 32, 'ave(X)', t_ops, t_wrt) -C -C Traceurs -C -! DO iq=1,nqtot -! call histdef(histaveid, ttext(iq), ttext(iq), '-', -! . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, -! . 32, 'ave(X)', t_ops, t_wrt) -! enddo -C -C Masse -C - call histdef(histaveid, 'masse', 'masse', 'kg', - . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, - . 32, 'ave(X)', t_ops, t_wrt) -C -C Pression au sol -C - call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', - . iip1, jjp1, thoriid, 1, 1, 1, -99, - . 32, 'ave(X)', t_ops, t_wrt) -C -C Geopotentiel au sol -C -! call histdef(histaveid, 'phis', 'geopotentiel au sol', '-', -! . iip1, jjp1, thoriid, 1, 1, 1, -99, -! . 32, 'ave(X)', t_ops, t_wrt) -!C -C Fin -C - call histend(histaveid) - call histend(histuaveid) - call histend(histvaveid) -#else -! tell the user this routine should be run with ioipsl - write(lunout,*)"initdynav: Warning this routine should not be", - & " used without ioipsl" -#endif -! of #ifdef CPP_IOIPSL - return - end Index: LMDZ5/branches/testing/libf/bibio/initdynav.F90 =================================================================== --- LMDZ5/branches/testing/libf/bibio/initdynav.F90 (revision 1665) +++ LMDZ5/branches/testing/libf/bibio/initdynav.F90 (revision 1665) @@ -0,0 +1,194 @@ +! $Id$ + +subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt) + +#ifdef CPP_IOIPSL + USE IOIPSL +#endif + USE infotrac, ONLY : nqtot, ttext + use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, & + dynhistave_file,dynhistvave_file,dynhistuave_file + implicit none + + + ! Routine d'initialisation des ecritures des fichiers histoires LMDZ + ! au format IOIPSL. Initialisation du fichier histoire moyenne. + + ! Appels succesifs des routines: histbeg + ! histhori + ! histver + ! histdef + ! histend + + ! Entree: + + ! infile: nom du fichier histoire a creer + ! day0,anne0: date de reference + ! tstep : frequence d'ecriture + ! t_ops: frequence de l'operation pour IOIPSL + ! t_wrt: frequence d'ecriture sur le fichier + + + ! L. Fairhead, LMD, 03/99 + + include "dimensions.h" + include "paramet.h" + include "comconst.h" + include "comvert.h" + include "comgeom.h" + include "temps.h" + include "ener.h" + include "logic.h" + include "description.h" + include "serre.h" + include "iniprint.h" + + ! Arguments + + integer day0, anne0 + real tstep, t_ops, t_wrt + +#ifdef CPP_IOIPSL + ! This routine needs IOIPSL to work + ! Variables locales + + integer tau0 + real zjulian + integer iq + real rlong(iip1,jjp1), rlat(iip1,jjp1) + integer uhoriid, vhoriid, thoriid, zvertiid + integer ii,jj + integer zan, dayref + + !-------------------------------------------------------------------- + + ! Initialisations + + pi = 4. * atan (1.) + + ! Appel a histbeg: creation du fichier netcdf et initialisations diverses + + + zan = anne0 + dayref = day0 + CALL ymds2ju(zan, 1, dayref, 0.0, zjulian) + tau0 = itau_dyn + + do jj = 1, jjp1 + do ii = 1, iip1 + rlong(ii,jj) = rlonv(ii) * 180. / pi + rlat(ii,jj) = rlatu(jj) * 180. / pi + enddo + enddo + + ! Creation de 3 fichiers pour les differentes grilles horizontales + ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier + ! Grille Scalaire + call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), & + 1, iip1, 1, jjp1, & + tau0, zjulian, tstep, thoriid,histaveid) + + ! Creation du fichier histoire pour les grilles en V et U (oblige + ! pour l'instant, IOIPSL ne permet pas de grilles avec des nombres + ! de point differents dans un meme fichier) + ! Grille V + do jj = 1, jjm + do ii = 1, iip1 + rlong(ii,jj) = rlonv(ii) * 180. / pi + rlat(ii,jj) = rlatv(jj) * 180. / pi + enddo + enddo + + call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:), & + 1, iip1, 1, jjm, & + tau0, zjulian, tstep, vhoriid,histvaveid) + ! Grille U + do jj = 1, jjp1 + do ii = 1, iip1 + rlong(ii,jj) = rlonu(ii) * 180. / pi + rlat(ii,jj) = rlatu(jj) * 180. / pi + enddo + enddo + + call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:), & + 1, iip1, 1, jjp1, & + tau0, zjulian, tstep, uhoriid,histuaveid) + + ! Appel a histvert pour la grille verticale + + call histvert(histaveid,'presnivs','Niveaux Pression approximatifs','mb', & + llm, presnivs/100., zvertiid,'down') + call histvert(histuaveid,'presnivs','Niveaux Pression approximatifs','mb', & + llm, presnivs/100., zvertiid,'down') + call histvert(histvaveid,'presnivs','Niveaux Pression approximatifs','mb', & + llm, presnivs/100., zvertiid,'down') + + ! Appels a histdef pour la definition des variables a sauvegarder + + ! Vents U + + call histdef(histuaveid, 'u', 'vent u moyen ', & + 'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, & + 32, 'ave(X)', t_ops, t_wrt) + + ! Vents V + + call histdef(histvaveid, 'v', 'vent v moyen', & + 'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid, & + 32, 'ave(X)', t_ops, t_wrt) + + + ! Temperature + + call histdef(histaveid, 'temp', 'temperature moyenne', 'K', & + iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & + 32, 'ave(X)', t_ops, t_wrt) + + ! Temperature potentielle + + call histdef(histaveid, 'theta', 'temperature potentielle', 'K', & + iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & + 32, 'ave(X)', t_ops, t_wrt) + + ! Geopotentiel + + call histdef(histaveid, 'phi', 'geopotentiel moyen', '-', & + iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & + 32, 'ave(X)', t_ops, t_wrt) + + ! Traceurs + + ! DO iq=1,nqtot + ! call histdef(histaveid, ttext(iq), ttext(iq), '-', & + ! iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & + ! 32, 'ave(X)', t_ops, t_wrt) + ! enddo + + ! Masse + + call histdef(histaveid, 'masse', 'masse', 'kg', & + iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & + 32, 'ave(X)', t_ops, t_wrt) + + ! Pression au sol + + call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', & + iip1, jjp1, thoriid, 1, 1, 1, -99, & + 32, 'ave(X)', t_ops, t_wrt) + + ! Geopotentiel au sol + + ! call histdef(histaveid, 'phis', 'geopotentiel au sol', '-', & + ! iip1, jjp1, thoriid, 1, 1, 1, -99, & + ! 32, 'ave(X)', t_ops, t_wrt) + + call histend(histaveid) + call histend(histuaveid) + call histend(histvaveid) +#else + write(lunout,*)"initdynav: Warning this routine should not be", & + " used without ioipsl" +#endif + ! of #ifdef CPP_IOIPSL + +end subroutine initdynav Index: LMDZ5/branches/testing/libf/bibio/lnblnk.F =================================================================== --- LMDZ5/branches/testing/libf/bibio/lnblnk.F (revision 1663) +++ (revision ) @@ -1,39 +1,0 @@ -! -! $Header$ -! - INTEGER FUNCTION lnblnk (letter) - -C-------------------------------------------------------- -C Fonction qui determine la longeur d'un string sans les -C blancs qui suivent. Le critere pour determiner la fin du -C string est, trois blancs de suite -C--------------------------------------------------------- -C ARGUMENTS -C +++++++++ -C letter: CHARACTER*xxx (xxx < imax) -C le string dont on determine la longuer -C lnblnk: INTEGER -C le nombre de characteres -C -C PARAMETER -C +++++++++ -C imax : INTEGER -C le nombre maximale de character que peut contenir le string -C a traiter - - IMPLICIT NONE - INTEGER i,imax - PARAMETER (imax = 256) - CHARACTER(*) letter - - i=0 - -10 i=i+1 - IF (letter(i:i+3) . EQ . ' ') GOTO 20 - GOTO 10 - -20 lnblnk=i-1 - - RETURN - END - Index: LMDZ5/branches/testing/libf/bibio/new_unit.F90 =================================================================== --- LMDZ5/branches/testing/libf/bibio/new_unit.F90 (revision 1665) +++ LMDZ5/branches/testing/libf/bibio/new_unit.F90 (revision 1665) @@ -0,0 +1,25 @@ +module new_unit_m + + implicit none + +contains + + subroutine new_unit(unit) + + integer, intent(out):: unit + + ! Variables local to the procedure: + logical opened, exist + + !------------------------------------------------------ + + unit = 0 + do + inquire(unit=unit, opened=opened, exist=exist) + if (exist .and. .not. opened) exit + unit = unit + 1 + end do + + end subroutine new_unit + +end module new_unit_m Index: LMDZ5/branches/testing/libf/bibio/writedynav.F =================================================================== --- LMDZ5/branches/testing/libf/bibio/writedynav.F (revision 1663) +++ (revision ) @@ -1,152 +1,0 @@ -! -! $Id$ -! - subroutine writedynav(time, vcov, - , ucov,teta,ppk,phi,q,masse,ps,phis) - -#ifdef CPP_IOIPSL - USE ioipsl -#endif - USE infotrac, ONLY : nqtot, ttext - use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid - implicit none - -C -C Ecriture du fichier histoire au format IOIPSL -C -C Appels succesifs des routines: histwrite -C -C Entree: -C time: temps de l'ecriture -C vcov: vents v covariants -C ucov: vents u covariants -C teta: temperature potentielle -C phi : geopotentiel instantane -C q : traceurs -C masse: masse -C ps :pression au sol -C phis : geopotentiel au sol -C -C -C -C L. Fairhead, LMD, 03/99 -C -C ===================================================================== -C -C Declarations -#include "dimensions.h" -#include "paramet.h" -#include "comconst.h" -#include "comvert.h" -#include "comgeom.h" -#include "temps.h" -#include "ener.h" -#include "logic.h" -#include "description.h" -#include "serre.h" -#include "iniprint.h" - -C -C Arguments -C - - REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) - REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm) - REAL ps(ip1jmp1),masse(ip1jmp1,llm) - REAL phis(ip1jmp1) - REAL q(ip1jmp1,llm,nqtot) - integer time - - -#ifdef CPP_IOIPSL -! This routine needs IOIPSL to work -C Variables locales -C - integer ndex2d(ip1jmp1),ndexu(ip1jmp1*llm),ndexv(ip1jm*llm) - INTEGER iq, ii, ll - real tm(ip1jmp1*llm) - REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) - logical ok_sync - integer itau_w -C -C Initialisations -C - ndexu = 0 - ndexv = 0 - ndex2d = 0 - ok_sync = .TRUE. - tm = 999.999 - vnat = 999.999 - unat = 999.999 - itau_w = itau_dyn + time - -C Passage aux composantes naturelles du vent - call covnat(llm, ucov, vcov, unat, vnat) - -C -C Appels a histwrite pour l'ecriture des variables a sauvegarder -C -C Vents U -C - call histwrite(histuaveid, 'u', itau_w, unat, - . iip1*jjp1*llm, ndexu) -C -C Vents V -C - call histwrite(histvaveid, 'v', itau_w, vnat, - . iip1*jjm*llm, ndexv) -C -C Temperature potentielle moyennee -C - call histwrite(histaveid, 'theta', itau_w, teta, - . iip1*jjp1*llm, ndexu) -C -C Temperature moyennee -C - do ii = 1, ijp1llm - tm(ii) = teta(ii) * ppk(ii)/cpp - enddo - call histwrite(histaveid, 'temp', itau_w, tm, - . iip1*jjp1*llm, ndexu) -C -C Geopotentiel -C - call histwrite(histaveid, 'phi', itau_w, phi, - . iip1*jjp1*llm, ndexu) -C -C Traceurs -C -! DO iq=1,nqtot -! call histwrite(histaveid, ttext(iq), itau_w, q(:,:,iq), -! . iip1*jjp1*llm, ndexu) -! enddo -C -C Masse -C - call histwrite(histaveid, 'masse', itau_w, masse, - $ iip1*jjp1*llm, ndexu) -C -C Pression au sol -C - call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d) -C -C Geopotentiel au sol -C -! call histwrite(histaveid,'phis',itau_w, phis,iip1*jjp1, ndex2d) -C -C Fin -C - if (ok_sync) then - call histsync(histaveid) - call histsync(histvaveid) - call histsync(histuaveid) - ENDIF - -#else -! tell the user this routine should be run with ioipsl - write(lunout,*)"writedynav: Warning this routine should not be", - & " used without ioipsl" -#endif -! of #ifdef CPP_IOIPSL - return - end Index: LMDZ5/branches/testing/libf/bibio/writedynav.F90 =================================================================== --- LMDZ5/branches/testing/libf/bibio/writedynav.F90 (revision 1665) +++ LMDZ5/branches/testing/libf/bibio/writedynav.F90 (revision 1665) @@ -0,0 +1,141 @@ +! $Id$ + +subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis) + +#ifdef CPP_IOIPSL + USE ioipsl +#endif + USE infotrac, ONLY : nqtot, ttext + use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid + + implicit none + + ! Ecriture du fichier histoire au format IOIPSL + + ! Appels succesifs des routines: histwrite + + ! Entree: + ! time: temps de l'ecriture + ! vcov: vents v covariants + ! ucov: vents u covariants + ! teta: temperature potentielle + ! phi : geopotentiel instantane + ! q : traceurs + ! masse: masse + ! ps :pression au sol + ! phis : geopotentiel au sol + + ! L. Fairhead, LMD, 03/99 + + ! Declarations + include "dimensions.h" + include "paramet.h" + include "comconst.h" + include "comvert.h" + include "comgeom.h" + include "temps.h" + include "ener.h" + include "logic.h" + include "description.h" + include "serre.h" + include "iniprint.h" + + ! Arguments + + REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) + REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm) + REAL ps(ip1jmp1), masse(ip1jmp1, llm) + REAL phis(ip1jmp1) + REAL q(ip1jmp1, llm, nqtot) + integer time + +#ifdef CPP_IOIPSL + ! This routine needs IOIPSL to work + ! Variables locales + + integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm) + INTEGER iq, ii, ll + real tm(ip1jmp1*llm) + REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) + logical ok_sync + integer itau_w + + !----------------------------------------------------------------- + + ! Initialisations + + ndexu = 0 + ndexv = 0 + ndex2d = 0 + ok_sync = .TRUE. + tm = 999.999 + vnat = 999.999 + unat = 999.999 + itau_w = itau_dyn + time + + ! Passage aux composantes naturelles du vent + call covnat(llm, ucov, vcov, unat, vnat) + + ! Appels a histwrite pour l'ecriture des variables a sauvegarder + + ! Vents U + + call histwrite(histuaveid, 'u', itau_w, unat, & + iip1*jjp1*llm, ndexu) + + ! Vents V + + call histwrite(histvaveid, 'v', itau_w, vnat, & + iip1*jjm*llm, ndexv) + + ! Temperature potentielle moyennee + + call histwrite(histaveid, 'theta', itau_w, teta, & + iip1*jjp1*llm, ndexu) + + ! Temperature moyennee + + do ii = 1, ijp1llm + tm(ii) = teta(ii) * ppk(ii)/cpp + enddo + call histwrite(histaveid, 'temp', itau_w, tm, & + iip1*jjp1*llm, ndexu) + + ! Geopotentiel + + call histwrite(histaveid, 'phi', itau_w, phi, & + iip1*jjp1*llm, ndexu) + + ! Traceurs + + ! DO iq=1, nqtot + ! call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), & + ! iip1*jjp1*llm, ndexu) + ! enddo + + ! Masse + + call histwrite(histaveid, 'masse', itau_w, masse, & + iip1*jjp1*llm, ndexu) + + ! Pression au sol + + call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d) + + ! Geopotentiel au sol + + ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d) + + if (ok_sync) then + call histsync(histaveid) + call histsync(histvaveid) + call histsync(histuaveid) + ENDIF + +#else + write(lunout, *) "writedynav: Warning this routine should not be", & + " used without ioipsl" +#endif + ! of #ifdef CPP_IOIPSL + +end subroutine writedynav