source: trunk/LMDZ.TITAN/libf/phytitan/write_archive.F @ 1243

Last change on this file since 1243 was 1056, checked in by slebonnois, 11 years ago

SL: Titan runs ! see DOC/chantiers/commit_importants.log
File size: 5.2 KB
Line 
1c=======================================================================
2      subroutine write_archive(nid,nom,titre,unite,dim,px)
3c=======================================================================
4c
5c
6c   Date:    01/1997
7c   ----
8c
9c   Objet:   Ecriture de champs sur grille scalaire (iip1*jjp1)
10c   -----    dans un fichier DRS nomme "start_archive"
11c
12c    Il faut au prealable avoir cree un entete avec un "call ini_archive".
13c    Ces variables peuvent etre 3d (ex: temperature), 2d (ex: temperature
14c    de surface), ou 0d (pour un scalaire qui ne depend que du temps)
15c    (ex: la longitude solaire)
16c
17c
18c   Arguments:
19c   ----------
20c
21c     Inputs:
22c     ------
23c
24c                 nid      Unite logique du fichier "start_archive"
25c         nom      nom du champ a ecrire dans le fichier "start_archive"
26c         titre    titre de la variable dans le fichier DRS "start_archive"
27c         unite    unite de la variable ....
28c         dim      dimension de la variable a ecrire
29c         px       tableau contenant la variable a ecrire
30c
31c
32c=======================================================================
33
34      USE control_mod
35
36      implicit none
37
38#include "dimensions.h"
39#include "paramet.h"
40#include "comvert.h"
41#include "comgeom.h"
42#include "description.h"
43#include "temps.h"
44#include "netcdf.inc"
45
46c-----------------------------------------------------------------------
47c       Declarations   
48c-----------------------------------------------------------------------
49
50c Arguments:
51
52      INTEGER nid,ntime,dim
53      REAL px(iip1,jjp1,llm)
54
55      CHARACTER*(*) nom, titre, unite
56
57      integer ierr
58
59
60c local
61      integer, dimension(4) :: edges,corner,id
62      integer :: varid,i,j,l
63
64      ntime = 1
65     
66c-----------------------------------------------------------------------
67c      Ecriture du champs dans le fichier            (3 cas)     
68c-----------------------------------------------------------------------
69
70!Cas Variable 3D
71!---------------
72        if (dim.eq.3) then
73
74!         Ecriture du champs
75
76! nom de la variable
77           ierr= NF_INQ_VARID(nid,nom,varid)
78           if (ierr /= NF_NOERR) then
79! choix du nom des coordonnees
80              ierr= NF_INQ_DIMID(nid,"rlonv",id(1))
81              ierr= NF_INQ_DIMID(nid,"rlatu",id(2))
82              ierr= NF_INQ_DIMID(nid,"sigs",id(3))
83              ierr= NF_INQ_DIMID(nid,"Time",id(4))
84
85! Creation de la variable si elle n'existait pas
86
87              write (*,*) "====================="
88              write (*,*) "creation de ",nom
89              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
90
91           endif
92
93           corner(1)=1
94           corner(2)=1
95           corner(3)=1
96           corner(4)=ntime
97
98           edges(1)=iip1
99           edges(2)=jjp1
100           edges(3)=llm
101           edges(4)=1
102#ifdef NC_DOUBLE
103           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
104#else
105           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
106#endif
107
108           if (ierr.ne.NF_NOERR) then
109              write(*,*) "***** PUT_VAR matter in write_archive"
110              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
111              call abort
112           endif
113
114!Cas Variable 2D
115!---------------
116
117        else if (dim.eq.2) then
118
119!         Ecriture du champs
120
121           ierr= NF_INQ_VARID(nid,nom,varid)
122           if (ierr /= NF_NOERR) then
123!  choix du nom des coordonnees
124              ierr= NF_INQ_DIMID(nid,"rlonv",id(1))
125              ierr= NF_INQ_DIMID(nid,"rlatu",id(2))
126              ierr= NF_INQ_DIMID(nid,"Time",id(3))
127
128! Creation de la variable si elle n'existait pas
129
130              write (*,*) "====================="
131              write (*,*) "creation de ",nom
132
133              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
134
135           endif
136
137           corner(1)=1
138           corner(2)=1
139           corner(3)=ntime
140           edges(1)=iip1
141           edges(2)=jjp1
142           edges(3)=1
143
144
145#ifdef NC_DOUBLE
146           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
147#else         
148           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
149#endif     
150
151           if (ierr.ne.NF_NOERR) then
152              write(*,*) "***** PUT_VAR matter in write_archive"
153              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
154              call abort
155           endif
156
157
158!Cas Variable 0D (scalaire dependant du temps)
159!---------------------------------------------
160
161        else if (dim.eq.0) then
162
163!         Ecriture du champs
164
165           ierr= NF_INQ_VARID(nid,nom,varid)
166           if (ierr /= NF_NOERR) then
167!  choix du nom des coordonnees
168              ierr= NF_INQ_DIMID(nid,"temps",id(1))
169
170! Creation de la variable si elle n'existait pas
171
172              write (*,*) "====================="
173              write (*,*) "creation de ",nom
174
175              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
176
177           endif
178
179           corner(1)=ntime
180           edges(1)=1
181
182#ifdef NC_DOUBLE
183           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
184#else
185           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
186#endif
187           if (ierr.ne.NF_NOERR) then
188              write(*,*) "***** PUT_VAR matter in write_archive"
189              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
190              call abort
191           endif
192
193        endif
194
195      return
196      end
197
Note: See TracBrowser for help on using the repository browser.