c $Header$ c SUBROUTINE dynredem0(fichnom,iday_end,phis,nq) USE IOIPSL IMPLICIT NONE c======================================================================= c Ecriture du fichier de redemarrage sous format NetCDF (initialisation) c======================================================================= c Declarations: c ------------- #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 "netcdf.inc" #include "description.h" #include "serre.h" c Arguments: c ---------- INTEGER iday_end REAL phis(ip1jmp1) CHARACTER*(*) fichnom INTEGER nq c Local: c ------ INTEGER iq,l CHARACTER str3*3 INTEGER length PARAMETER (length = 100) REAL tab_cntrl(length) ! tableau des parametres du run INTEGER ierr character*20 modname character*80 abort_message c Variables locales pour NetCDF: c INTEGER dims2(2), dims3(3), dims4(4) INTEGER idim_index INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv INTEGER idim_s, idim_sig INTEGER idim_tim INTEGER nid,nvarid REAL zan0,zjulian,hours INTEGER yyears0,jjour0, mmois0 character*30 unites c----------------------------------------------------------------------- modname='dynredem' call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian) call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours) DO l=1,length tab_cntrl(l) = 0. ENDDO tab_cntrl(1) = FLOAT(iim) tab_cntrl(2) = FLOAT(jjm) tab_cntrl(3) = FLOAT(llm) tab_cntrl(4) = FLOAT(day_ref) tab_cntrl(5) = FLOAT(annee_ref) tab_cntrl(6) = rad tab_cntrl(7) = omeg tab_cntrl(8) = g tab_cntrl(9) = cpp tab_cntrl(10) = kappa tab_cntrl(11) = daysec tab_cntrl(12) = dtvr tab_cntrl(13) = etot0 tab_cntrl(14) = ptot0 tab_cntrl(15) = ztot0 tab_cntrl(16) = stot0 tab_cntrl(17) = ang0 tab_cntrl(18) = pa tab_cntrl(19) = preff c c ..... parametres pour le zoom ...... tab_cntrl(20) = clon tab_cntrl(21) = clat tab_cntrl(22) = grossismx tab_cntrl(23) = grossismy c IF ( fxyhypb ) THEN tab_cntrl(24) = 1. tab_cntrl(25) = dzoomx tab_cntrl(26) = dzoomy tab_cntrl(27) = 0. tab_cntrl(28) = taux tab_cntrl(29) = tauy ELSE tab_cntrl(24) = 0. tab_cntrl(25) = dzoomx tab_cntrl(26) = dzoomy tab_cntrl(27) = 0. tab_cntrl(28) = 0. tab_cntrl(29) = 0. IF( ysinus ) tab_cntrl(27) = 1. ENDIF tab_cntrl(30) = FLOAT(iday_end) tab_cntrl(31) = FLOAT(itau_dyn + itaufin) c c ......................................................... c c Creation du fichier: c ierr = NF_CREATE(fichnom, NF_CLOBBER, nid) IF (ierr.NE.NF_NOERR) THEN WRITE(6,*)" Pb d ouverture du fichier "//fichnom WRITE(6,*)' ierr = ', ierr CALL ABORT ENDIF c c Preciser quelques attributs globaux: c ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27, . "Fichier demmarage dynamique") c c Definir les dimensions du fichiers: c ierr = NF_DEF_DIM (nid, "index", length, idim_index) ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu) ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu) ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv) ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv) ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s) ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig) ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim) c ierr = NF_ENDDEF(nid) ! sortir du mode de definition c c Definir et enregistrer certains champs invariants: c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, . "Parametres de controle") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, . "Longitudes des points U") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, . "Latitudes des points U") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23, . "Longitudes des points V") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, . "Latitudes des points V") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28, . "Numero naturel des couches s") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32, . "Numero naturel des couches sigma") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, . "Coefficient A pour hybride") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,ap) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26, . "Coefficient B pour hybride") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,bp) #endif c ierr = NF_REDEF (nid) ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid) ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs) #endif c c Coefficients de passage cov. <-> contra. <--> naturel c ierr = NF_REDEF (nid) dims2(1) = idim_rlonu dims2(2) = idim_rlatu ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, . "Coefficient de passage pour U") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,cu) #endif c ierr = NF_REDEF (nid) dims2(1) = idim_rlonv dims2(2) = idim_rlatv ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29, . "Coefficient de passage pour V") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,cv) #endif c c Aire de chaque maille: c ierr = NF_REDEF (nid) dims2(1) = idim_rlonv dims2(2) = idim_rlatu ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22, . "Aires de chaque maille") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,aire) #endif c c Geopentiel au sol: c ierr = NF_REDEF (nid) dims2(1) = idim_rlonv dims2(2) = idim_rlatu ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, . "Geopotentiel au sol") ierr = NF_ENDDEF(nid) #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,phis) #endif c c Definir les variables pour pouvoir les enregistrer plus tard: c ierr = NF_REDEF (nid) ! entrer dans le mode de definition c ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19, . "Temps de simulation") write(unites,200)yyears0,mmois0,jjour0 200 format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00') ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30, . unites) c dims4(1) = idim_rlonu dims4(2) = idim_rlatu dims4(3) = idim_s dims4(4) = idim_tim ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, . "Vitesse U") c dims4(1) = idim_rlonv dims4(2) = idim_rlatv dims4(3) = idim_s dims4(4) = idim_tim ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9, . "Vitesse V") c dims4(1) = idim_rlonv dims4(2) = idim_rlatu dims4(3) = idim_s dims4(4) = idim_tim ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11, . "Temperature") c dims4(1) = idim_rlonv dims4(2) = idim_rlatu dims4(3) = idim_s dims4(4) = idim_tim IF(nq.GE.1) THEN DO iq=1,nq IF (iq.GT.99) THEN PRINT*, "Trop de traceurs" CALL abort ELSE str3(1:1)='q' WRITE(str3(2:3),'(i2.2)') iq ierr = NF_DEF_VAR (nid,str3,NF_FLOAT,4,dims4,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12, . "Traceurs "//str3) ENDIF ENDDO ENDIF c dims4(1) = idim_rlonv dims4(2) = idim_rlatu dims4(3) = idim_s dims4(4) = idim_tim ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12, . "C est quoi ?") c dims3(1) = idim_rlonv dims3(2) = idim_rlatu dims3(3) = idim_tim ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid) ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15, . "Pression au sol") c ierr = NF_ENDDEF(nid) ! sortir du mode de definition ierr = NF_CLOSE(nid) ! fermer le fichier PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end PRINT*,'rad,omeg,g,cpp,kappa', , rad,omeg,g,cpp,kappa RETURN END SUBROUTINE dynredem1(fichnom,time, . vcov,ucov,teta,q,nq,masse,ps) IMPLICIT NONE c================================================================= c Ecriture du fichier de redemarrage sous format NetCDF c================================================================= #include "dimensions.h" #include "paramet.h" #include "description.h" #include "netcdf.inc" #include "comvert.h" #include "comgeom.h" INTEGER nq, l REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) REAL teta(ip1jmp1,llm) REAL ps(ip1jmp1),masse(ip1jmp1,llm) REAL q(ip1jmp1,llm,nq) CHARACTER*(*) fichnom REAL time INTEGER nid, nvarid INTEGER ierr INTEGER iq CHARACTER str3*3 character*20 modname character*80 abort_message c INTEGER nb SAVE nb DATA nb / 0 / modname = 'dynredem1' ierr = NF_OPEN(fichnom, NF_WRITE, nid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Pb. d ouverture "//fichnom CALL abort ENDIF c Ecriture/extension de la coordonnee temps nb = nb + 1 ierr = NF_INQ_VARID(nid, "temps", nvarid) IF (ierr .NE. NF_NOERR) THEN print *, NF_STRERROR(ierr) abort_message='Variable temps n est pas definie' CALL abort_gcm(modname,abort_message,ierr) ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time) #else ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time) #endif PRINT*, "Enregistrement pour ", nb, time c Ecriture des champs c ierr = NF_INQ_VARID(nid, "ucov", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Variable ucov n est pas definie" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ucov) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,ucov) #endif ierr = NF_INQ_VARID(nid, "vcov", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Variable vcov n est pas definie" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,vcov) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,vcov) #endif ierr = NF_INQ_VARID(nid, "teta", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Variable teta n est pas definie" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,teta) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,teta) #endif IF(nq.GE.1) THEN DO iq=1,nq IF (iq.GT.99) THEN PRINT*, "Trop de traceurs" CALL abort ELSE str3(1:1)='q' WRITE(str3(2:3),'(i2.2)') iq ierr = NF_INQ_VARID(nid, str3, nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Variable "//str3//" n est pas definie" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) #endif ENDIF ENDDO ENDIF c ierr = NF_INQ_VARID(nid, "masse", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Variable masse n est pas definie" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,masse) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,masse) #endif c ierr = NF_INQ_VARID(nid, "ps", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "Variable ps n est pas definie" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ps) #else ierr = NF_PUT_VAR_REAL (nid,nvarid,ps) #endif ierr = NF_CLOSE(nid) c RETURN END