source: trunk/LMDZ.PLUTO/libf/dynphy_lonlat/phypluto/write_archive.F @ 3546

Last change on this file since 3546 was 3184, checked in by afalco, 11 months ago

Pluto PCM:
Added LMDZ.PLUTO, a copy of the generic model,
cleaned from some unnecessary modules (water, ...)
AF
File size: 8.0 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!      use slab_ice_h, only: noceanmx
36      ! USE ocean_slab_mod, ONLY: nslay
37
38      implicit none
39
40      include "dimensions.h"
41      include "paramet.h"
42      include "comgeom.h"
43      include "netcdf.inc"
44
45c-----------------------------------------------------------------------
46c       Declarations   
47c-----------------------------------------------------------------------
48
49c Arguments:
50
51      INTEGER nid
52      integer ntime ! time index
53      integer dim
54      REAL px(iip1,jjp1,llm)
55
56      CHARACTER*(*) nom, titre, unite
57
58      integer ierr
59
60
61c local
62      integer, dimension(4) :: edges,corner,id
63      integer :: varid,i,j,l
64c-----------------------------------------------------------------------
65c      Ecriture du champs dans le fichier            (3 cas)     
66c-----------------------------------------------------------------------
67
68! For an atmospheric 3D Variable
69!--------------------------------
70        if (dim.eq.3) then
71
72!         Ecriture du champs
73
74! nom de la variable
75           ierr= NF_INQ_VARID(nid,nom,varid)
76           if (ierr /= NF_NOERR) then
77! choix du nom des coordonnees
78              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
79              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
80              ierr= NF_INQ_DIMID(nid,"altitude",id(3))
81              ierr= NF_INQ_DIMID(nid,"Time",id(4))
82
83! Creation de la variable si elle n'existait pas
84
85              write (*,*) "====================="
86              write (*,*) "defining ",nom
87              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
88
89           endif
90
91! mars s'arranger pour qu'il n'y ai plus besoin de ca
92
93c          do l=1,llm
94c             do j=1,jjp1
95c                do i=1,iip1
96c                   pxbis(i,j,l)=px(i,j,llm-l+1)
97c                enddo
98c             enddo
99c          enddo
100           corner(1)=1
101           corner(2)=1
102           corner(3)=1
103           corner(4)=ntime
104
105           edges(1)=iip1
106           edges(2)=jjp1
107           edges(3)=llm
108           edges(4)=1
109#ifdef NC_DOUBLE
110           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
111#else
112           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
113#endif
114
115           if (ierr.ne.NF_NOERR) then
116              write(*,*) "***** PUT_VAR problem in write_archive"
117              write(*,*) "***** with ",trim(nom)," ",nf_STRERROR(ierr)
118              call abort
119           endif
120
121
122! For a subterranean 3D Variable
123!-------------------------------
124
125        else if (dim.eq.-3) then
126        ! get variables' ID, if it exists
127        ierr=NF_INQ_VARID(nid,nom,varid)
128       
129         if (ierr.ne.NF_NOERR) then ! variable not defined yet
130          ! build related coordinates
131          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
132          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
133          ierr=NF_INQ_DIMID(nid,"subsurface_layers",id(3))
134          if (ierr.ne.NF_NOERR) then
135           write(*,*)"write_archive: dimension <subsurface_layers>",
136     &               " is missing !!!"
137           call abort
138          endif
139          ierr=NF_INQ_DIMID(nid,"Time",id(4))
140         
141          ! define the variable
142          write(*,*)"====================="
143          write(*,*)"defining variable ",trim(nom)
144          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
145         
146         endif
147
148        ! build cedges and corners
149        corner(1)=1
150        corner(2)=1
151        corner(3)=1
152        corner(4)=ntime
153
154        edges(1)=iip1
155        edges(2)=jjp1
156        edges(3)=nsoilmx
157        edges(4)=1
158#ifdef NC_DOUBLE
159           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
160#else
161           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
162#endif
163
164! For a 3D ocean temperature Variable
165!-------------------------------
166
167        else if (dim.eq.-2) then
168        ! get variables' ID, if it exists
169        ierr=NF_INQ_VARID(nid,nom,varid)
170
171         if (ierr.ne.NF_NOERR) then ! variable not defined yet
172          ! build related coordinates
173          ierr=NF_INQ_DIMID(nid,"longitude",id(1))
174          ierr=NF_INQ_DIMID(nid,"latitude",id(2))
175          ierr=NF_INQ_DIMID(nid,"ocean_layers",id(3))
176          if (ierr.ne.NF_NOERR) then
177           write(*,*)"write_archive: dimension <ocean_layers>",
178     &               " is missing !!!"
179           call abort
180          endif
181          ierr=NF_INQ_DIMID(nid,"Time",id(4))
182
183          ! define the variable
184          write(*,*)"====================="
185          write(*,*)"defining variable ",trim(nom)
186          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
187
188         endif
189
190        ! build cedges and corners
191        corner(1)=1
192        corner(2)=1
193        corner(3)=1
194        corner(4)=ntime
195
196        edges(1)=iip1
197        edges(2)=jjp1
198      !   edges(3)=nslay
199        edges(3)=0 !AF24
200        edges(4)=1
201#ifdef NC_DOUBLE
202           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
203#else
204           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
205#endif
206
207
208
209! For a surface 2D Variable
210!--------------------------
211
212        else if (dim.eq.2) then
213
214!         Ecriture du champs
215
216           ierr= NF_INQ_VARID(nid,nom,varid)
217           if (ierr /= NF_NOERR) then
218!  choix du nom des coordonnees
219              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
220              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
221              ierr= NF_INQ_DIMID(nid,"Time",id(3))
222
223! Creation de la variable si elle n'existait pas
224
225              write (*,*) "====================="
226              write (*,*) "defining variable ",trim(nom)
227
228              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
229
230           endif
231
232           corner(1)=1
233           corner(2)=1
234           corner(3)=ntime
235           edges(1)=iip1
236           edges(2)=jjp1
237           edges(3)=1
238
239
240#ifdef NC_DOUBLE
241           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
242#else         
243           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
244#endif     
245
246           if (ierr.ne.NF_NOERR) then
247              write(*,*) "***** PUT_VAR problem in write_archive"
248              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
249              call abort
250           endif
251
252
253!Cas Variable 0D (scalaire dependant du temps)
254!---------------------------------------------
255
256        else if (dim.eq.0) then
257
258!         Ecriture du champs
259
260           ierr= NF_INQ_VARID(nid,nom,varid)
261           if (ierr /= NF_NOERR) then
262!  choix du nom des coordonnees
263              ierr= NF_INQ_DIMID(nid,"Time",id(1))
264
265! Creation de la variable si elle n'existait pas
266
267              write (*,*) "====================="
268              write (*,*) "defining variable ",trim(nom)
269
270              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
271
272           endif
273
274           corner(1)=ntime
275           edges(1)=1
276
277#ifdef NC_DOUBLE
278           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
279#else
280           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
281#endif
282           if (ierr.ne.NF_NOERR) then
283              write(*,*) "***** PUT_VAR problem in write_archive"
284              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
285              call abort
286           endif
287
288        else
289          write(*,*) "write_archive: dim=",dim," ?!?"
290          call abort
291        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
292
293      end
294
Note: See TracBrowser for help on using the repository browser.