source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/write_archive.F @ 253

Last change on this file since 253 was 222, checked in by ymipsl, 10 years ago

Creating temporary dynamico/lmdz/saturn branche

YM
File size: 6.7 KB
Line 
1c=======================================================================
2      subroutine write_archive(nid,ntime,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 comsoil_h, only: nsoilmx
35      implicit none
36
37#include "dimensions.h"
38#include "paramet.h"
39#include "comvert.h"
40#include "comgeom.h"
41#include "temps.h"
42#include "netcdf.inc"
43
44c-----------------------------------------------------------------------
45c       Declarations   
46c-----------------------------------------------------------------------
47
48c Arguments:
49
50      INTEGER nid
51      integer ntime ! time index
52      integer 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
63c-----------------------------------------------------------------------
64c      Ecriture du champs dans le fichier            (3 cas)     
65c-----------------------------------------------------------------------
66
67! For an atmospheric 3D Variable
68!--------------------------------
69        if (dim.eq.3) then
70
71!         Ecriture du champs
72
73! nom de la variable
74           ierr= NF_INQ_VARID(nid,nom,varid)
75           if (ierr /= NF_NOERR) then
76! choix du nom des coordonnees
77              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
78              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
79              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
80              ierr= NF_INQ_DIMID(nid,"Time",id(4))
81
82! Creation de la variable si elle n'existait pas
83
84              write (*,*) "====================="
85              write (*,*) "creation de ",nom
86              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
87
88           endif
89
90! mars s'arranger pour qu'il n'y ai plus besoin de ca
91
92c          do l=1,llm
93c             do j=1,jjp1
94c                do i=1,iip1
95c                   pxbis(i,j,l)=px(i,j,llm-l+1)
96c                enddo
97c             enddo
98c          enddo
99           corner(1)=1
100           corner(2)=1
101           corner(3)=1
102           corner(4)=ntime
103
104           edges(1)=iip1
105           edges(2)=jjp1
106           edges(3)=llm
107           edges(4)=1
108#ifdef NC_DOUBLE
109           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
110#else
111           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
112#endif
113
114           if (ierr.ne.NF_NOERR) then
115              write(*,*) "***** PUT_VAR matter in write_archive"
116              write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
117              call abort
118           endif
119
120
121! For a subterranean 3D Variable
122!-------------------------------
123
124        else if (dim.eq.-3) then
125        ! get variables' ID, if it exists
126        ierr=NF_INQ_VARID(nid,nom,varid)
127       
128         if (ierr.ne.NF_NOERR) then ! variable not defined yet
129          ! build related coordinates
130          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
131          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
132          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
133          if (ierr.ne.NF_NOERR) then
134           write(*,*)"write_archive: dimension <subsurface_layers>",
135     &               " is missing !!!"
136           call abort
137          endif
138          ierr=NF_INQ_DIMID(nid,"Time",id(4))
139         
140          ! define the variable
141          write(*,*)"====================="
142          write(*,*)"defining ",nom
143          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
144         
145         endif
146
147        ! build cedges and corners
148        corner(1)=1
149        corner(2)=1
150        corner(3)=1
151        corner(4)=ntime
152
153        edges(1)=iip1
154        edges(2)=jjp1
155        edges(3)=nsoilmx
156        edges(4)=1
157#ifdef NC_DOUBLE
158           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
159#else
160           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
161#endif
162
163
164! For a surface 2D Variable
165!--------------------------
166
167        else if (dim.eq.2) then
168
169!         Ecriture du champs
170
171           ierr= NF_INQ_VARID(nid,nom,varid)
172           if (ierr /= NF_NOERR) then
173!  choix du nom des coordonnees
174              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
175              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
176              ierr= NF_INQ_DIMID(nid,"Time",id(3))
177
178! Creation de la variable si elle n'existait pas
179
180              write (*,*) "====================="
181              write (*,*) "creation de ",nom
182
183              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
184
185           endif
186
187           corner(1)=1
188           corner(2)=1
189           corner(3)=ntime
190           edges(1)=iip1
191           edges(2)=jjp1
192           edges(3)=1
193
194
195#ifdef NC_DOUBLE
196           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
197#else         
198           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
199#endif     
200
201           if (ierr.ne.NF_NOERR) then
202              write(*,*) "***** PUT_VAR matter in write_archive"
203              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
204              call abort
205           endif
206
207
208!Cas Variable 0D (scalaire dependant du temps)
209!---------------------------------------------
210
211        else if (dim.eq.0) then
212
213!         Ecriture du champs
214
215           ierr= NF_INQ_VARID(nid,nom,varid)
216           if (ierr /= NF_NOERR) then
217!  choix du nom des coordonnees
218              ierr= NF_INQ_DIMID(nid,"Time",id(1))
219
220! Creation de la variable si elle n'existait pas
221
222              write (*,*) "====================="
223              write (*,*) "creation de ",nom
224
225              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
226
227           endif
228
229           corner(1)=ntime
230           edges(1)=1
231
232#ifdef NC_DOUBLE
233           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
234#else
235           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
236#endif
237           if (ierr.ne.NF_NOERR) then
238              write(*,*) "***** PUT_VAR matter in write_archive"
239              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
240              call abort
241           endif
242
243        else
244          write(*,*) "write_archive: dim=",dim," ?!?"
245          call abort
246        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
247
248      return
249      end
250
Note: See TracBrowser for help on using the repository browser.