c=======================================================================
*=*=*=*= start2archive.html =*=*=*=*
PROGRAM start2archive c======================================================================= c c c Date: 01/1997 c ---- c c c Objet: Passage des fichiers drs d'etat initial "start" et c ----- "startfi" a un fichier drs unique "start_archive" c (rendu visible sous grads par dic2ctl) c c c "start_archive" est une banque d'etats initiaux: c On peut stocker plusieurs etats initiaux dans un meme fichier "start_archive" c (Veiller dans ce cas avoir un day_ini different pour chacun des start) c c c c======================================================================= implicit none #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comdissip.h" #include "comvert.h" #include "comgeom.h" #include "logic.h" #include "temps.h" #include "control.h" #include "ener.h" #include "drsdef.h" #include "description.h" #include "../phymars/dimphys.h" c----------------------------------------------------------------------- c Declarations c----------------------------------------------------------------------- c variables dynamiques du GCM c ----------------------------- REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants REAL h(ip1jmp1,llm) ! temperature potentielle REAL q(ip1jmp1,llm,nqmx) ! champs advectes REAL pext(ip1jmp1) ! pression extensive REAL pks(ip1jmp1),pksf(ip1jmp1) ! exner (f pour filtre) REAL phis(ip1jmp1) ! geopotentiel au sol c Variable Physiques (grille physique) c ------------------------------------ REAL tsurf(ngridmx),tsoil(ngridmx,nsoilmx),co2ice(ngridmx) REAL q2(ngridmx,nlayermx+1) REAL emis(ngridmx) INTEGER start,length PARAMETER (length = 100) REAL tab_cntrl_fi(length) ! tableau des parametres de startfi INTEGER*4 day_ini_fi c Variable naturelle / grille scalaire c ------------------------------------ REAL ps(ip1jmp1),T(ip1jmp1,llm),us(ip1jmp1,llm),vs(ip1jmp1,llm) REAL tsurfS(ip1jmp1),tsoilS(ip1jmp1,nsoilmx),co2iceS(ip1jmp1) REAL q2S(ip1jmp1,llm+1) REAL emisS(ip1jmp1) c Variables intermediaires : vent naturel, mais pas coord scalaire c---------------------------------------------------------------- REAL vn(ip1jm,llm),un(ip1jmp1,llm) c Fonctions DRS: c-------------- INTEGER setname, cluvdb, getdat,aslun,ierr,putvdim c Autres variables c ----------------- LOGICAL startdrs REAL ptotal, co2icetotal REAL date CHARACTER*2 str2 CHARACTER*80 fichier data fichier /'startfi'/ INTEGER ij, l,i,j,isoil INTEGER unit INTEGER it1, it2 c----------------------------------------------------------------------- c Initialisations c----------------------------------------------------------------------- grireg = .TRUE. startdrs = .TRUE. c======================================================================= c Lecture des donnees c======================================================================= call lectba(startdrs,nqmx,vcov,ucov,h,q,pext,phis,timedyn) call readfi(fichier,0,0,ngridmx,nsoilmx,startdrs, . day_ini_fi,timefi,co2ice,tsurf,tsoil,emis,q2) c----------------------------------------------------------------------- c Controle de la synchro c----------------------------------------------------------------------- if ((day_ini_fi.ne.day_ini).or.(abs(timefi-timedyn).gt.1.e-10)) & stop ' Probleme de Synchro entre start et startfi !!!' c----------------------------------------------------------------------- c Stockage de "tab_cntrl_fi" (tableau des param physiques) c----------------------------------------------------------------------- do i=1,length tab_cntrl_fi(i)=0. enddo c On relit specialement le tableau des parametres de startfi start = 94 ! On doit reouvrir startfi ierr = aslun(start,'startfi.dic', . start+1,'startfi.dat',IDRS_READ) ierr = CLUVDB() ierr = SETNAME(' ','controle',' ',' ',' ') ierr = GETDAT(start, tab_cntrl_fi, IDRS_BYTES_PER_WORD*length) c----------------------------------------------------------------------- c Initialisations c----------------------------------------------------------------------- call iniconst call inigeom call inifilr call exner(ip1jmp1,pext,aire,pks,pksf) c======================================================================= c Transformation EN VARIABLE NATURELLE / GRILLE SCALAIRE si ncessaire c======================================================================= c Les variables modeles dependent de la resolution. Il faut donc c eliminer les facteurs responsables de cette dependance c (pour utiliser newstart) c======================================================================= c----------------------------------------------------------------------- c Vent (depend de la resolution horizontale) c----------------------------------------------------------------------- c c ucov --> un et vcov --> vn c un --> us et vn --> vs c c----------------------------------------------------------------------- call covnat(llm,ucov, vcov, un, vn) call wind_scal(un,vn,us,vs) c----------------------------------------------------------------------- c Pression (depend de la resolution horizontale) c----------------------------------------------------------------------- c c pext --> ps c c----------------------------------------------------------------------- call multipl(ip1jmp1,pext,unsaire,ps) c----------------------------------------------------------------------- c Temperature (depend de la resolution verticale => de "sigma.def") c----------------------------------------------------------------------- c c h --> T c c----------------------------------------------------------------------- DO l=1,llm DO ij=1,ip1jmp1 T(ij,l) = h(ij,l)*pks(ij)*s(l) / cpp ENDDO ENDDO c----------------------------------------------------------------------- c Variable physique c----------------------------------------------------------------------- c c tsurf --> tsurfS c co2ice --> co2iceS c tsoil --> tsoilS c emis --> emisS c q2 --> q2S c c----------------------------------------------------------------------- call gr_fi_dyn(1,ngridmx,iip1,jjp1,tsurf,tsurfS) call gr_fi_dyn(1,ngridmx,iip1,jjp1,co2ice,co2iceS) call gr_fi_dyn(nsoilmx,ngridmx,iip1,jjp1,tsoil,tsoilS) call gr_fi_dyn(1,ngridmx,iip1,jjp1,emis,emisS) call gr_fi_dyn(llm+1,ngridmx,iip1,jjp1,q2,q2S) c======================================================================= c Info pour controler c======================================================================= ptotal = 0. co2icetotal = 0. DO j=1,jjp1 DO i=1,iim ptotal=ptotal+pext(i+(iim+1)*(j-1))/g co2icetotal = co2icetotal + & co2iceS(i+(iim+1)*(j-1))*aire(i+(iim+1)*(j-1)) ENDDO ENDDO write(*,*)'Ancienne grille : masse de l''atm :',ptotal write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal c----------------------------------------------------------------------- c Passage de "ptotal" et "co2icetotal" par tab_cntrl_fi c----------------------------------------------------------------------- tab_cntrl_fi(49) = ptotal tab_cntrl_fi(50) = co2icetotal c======================================================================= c Ecriture dans le fichier "start_archive" c======================================================================= unit = 44 c----------------------------------------------------------------------- c Ouverture de "start_archive" c----------------------------------------------------------------------- ierr = aslun(unit,'start_archive.dic', . unit+1,'start_archive.dat',IDRS_EXTEND) c----------------------------------------------------------------------- c si "start_archive" n'existe pas: c 1_ ouverture c 2_ creation de l'entete dynamique ("ini_archive") c----------------------------------------------------------------------- c ini_archive: c On met dans l'entete le tab_cntrl dynamique (1 a 16) c On y ajoute les valeurs du tab_cntrl_fi (a partir de 51) c En plus les deux valeurs ptotal et co2icetotal (99 et 100) c----------------------------------------------------------------------- if (ierr.ne.IDRS_SUCCESS) then ierr = aslun(unit,'start_archive.dic', . unit+1,'start_archive.dat',IDRS_CREATE) call ini_archive(unit,.true.,day_ini,phis,tab_cntrl_fi) endif c----------------------------------------------------------------------- c Ecriture de la coordonnee temps (date en jours) c----------------------------------------------------------------------- date = day_ini c date = 0. ierr = cluvdb() ierr = setname(' ','temps','temps simule','jours',' ') ierr = putvdim(unit,1,date,it1,it2) write(6,*)' WRITEDEM: it1, it2, ',it1 ,it2 c----------------------------------------------------------------------- c Ecriture des champs (co2ice,emis,ps,Tsurf,T,u,v,q2) c----------------------------------------------------------------------- c ATTENTION: q2 a une couche de plus!!!! c Pour creer un fichier DRS lisible par grads, c On passe donc une des couches de q2 a part c comme une variable 2D (la couche au sol: "q2surf") c Les lmm autres couches sont nommees "q2atm" (3D) c----------------------------------------------------------------------- call write_archive(unit,'co2ice','couche de glace co2', & 'kg/m2',2,co2iceS,date) call write_archive(unit,'emis','grd emis',' ',2,emisS,date) call write_archive(unit,'ps','Psurf','Pa',2,ps,date) call write_archive(unit,'Tsurf','Surf T','K',2,tsurfS,date) call write_archive(unit,'T','Temperature','K',3,t,date) call write_archive(unit,'u','Vent zonal','m.s-1',3,us,date) call write_archive(unit,'v','Vent merid','m.s-1',3,vs,date) call write_archive(unit,'q2surf','wind variance','m2.s-2',2, . q2S,date) call write_archive(unit,'q2atm','wind variance','m2.s-2',3, . q2S(1,2),date) c----------------------------------------------------------------------- c Ecriture du champs tsoil ( Tg[1,10] ) c----------------------------------------------------------------------- c "tsoil" Temperature au sol definie dans 10 couches dans le sol c Les 10 couches sont lues comme 10 champs c nommees Tg[1,10] do isoil=1,nsoilmx write(str2,'(i2.2)') isoil call write_archive(unit,'Tg'//str2,'Ground Temperature ','K', . 2,tsoilS(1,isoil),date) enddo c----------------------------------------------------------------------- c Fin c----------------------------------------------------------------------- end