c=======================================================================
*=*=*=*= write_archive.html =*=*=*=*
subroutine write_archive(unit,nom,titre,unite,dim,px,date) c======================================================================= c c c Date: 01/1997 c ---- c c Objet: Ecriture de champs sur grille scalaire (iip1*jjp1) c ----- dans un fichier DRS nomme "start_archive" c c Il faut au prealable avoir cree un entete avec un "call ini_archive". c Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature c de surface), ou 0d (pour un scalaire qui ne depend que du temps) c (ex: la longitude solaire) c c c Arguments: c ---------- c c Inputs: c ------ c c unit Unite logique du fichier "start_archive" c nom nom du champ a ecrire dans le fichier "start_archive" c titre titre de la variable dans le fichier DRS "start_archive" c unite unite de la variable .... c dim dimension de la variable a ecrire c px tableau contenant la variable a ecrire c date instant correspondant a la variable c c c======================================================================= implicit none #include "dimensions.h" #include "paramet.h" #include "control.h" #include "comvert.h" #include "comgeom.h" #include "description.h" #include "drsdef.h" #include "temps.h" c----------------------------------------------------------------------- c Declarations c----------------------------------------------------------------------- c Arguments: INTEGER unit, dim REAL date REAL px(iip1*jjp1*llm) CHARACTER*(*) nom, titre, unite c Fonctions DRS: c----------------------------------------------------------------------- c Ecriture du champs dans le fichier DRS (3 cas) c----------------------------------------------------------------------- c----------------------------------------------------------------------- c Cas Variable 3D c----------------------------------------------------------------------- if (dim.eq.3) then ierr = cluvdb() c choix des coordonnees pour le stockage ierr = setvdim(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1)) ierr = setvdim(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1)) ierr = setvdim(3,' ','sig_s',' ',' ',sig_s(1),sig_s(llm)) ierr = setvdim(4,' ','temps',' ',' ',date,date) c nom de la variable ierr = setname('Diagnostique physique',nom,titre,unite,' ') c ecriture du cahmp ierr = putdat(unit,px) c----------------------------------------------------------------------- c Cas Variable 2D c----------------------------------------------------------------------- else if (dim.eq.2) then ierr = cluvdb() c choix des coordonnees pour le stockage ierr = setvdim(1,' ','rlonv',' ',' ',rlonv(1),rlonv(iip1)) ierr = setvdim(2,' ','rlatu',' ',' ',rlatu(1),rlatu(jjp1)) ierr = setvdim(3,' ','temps',' ',' ',date,date) c nom de la variable ierr = setname('Diagnostique physique',nom,titre,unite,' ') c ecriture du cahmp ierr = putdat(unit,px) c----------------------------------------------------------------------- c Cas Variable 0D (scalaire dependant du temps) c----------------------------------------------------------------------- else if (dim.eq.0) then ierr = cluvdb() c choix des coordonnees pour le stockage ierr = setvdim(1,' ','temps',' ',' ',date,date) c nom de la variable ierr = setname('Diagnostique physique',nom,titre,unite,' ') c ecriture du cahmp ierr = putdat(unit,px) end if c----------------------------------------------------------------------- c Fin c----------------------------------------------------------------------- return end