source: trunk/LMDZ.GENERIC/libf/phystd/write_archive.F @ 1157

Last change on this file since 1157 was 993, checked in by emillour, 11 years ago

Generic GCM:

  • Some more cleanup in dynamics:
    • Moved "start2archive" (and auxilliary routines) to phystd
    • removed unused (obsolete) testharm.F , para_netcdf.h , readhead_NC.F , angtot.h from dyn3d
    • removed obsolete addit.F (and change corresponding lines in gcm)
    • remove unused "description.h" (and many places where it was "included")

EM
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      implicit none
35
36#include "dimensions.h"
37#include "dimphys.h"
38#include "paramet.h"
39#include "control.h"
40#include "comvert.h"
41#include "comgeom.h"
42#include "temps.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 (*,*) "creation de ",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 matter in write_archive"
117              write(*,*) "***** with ",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 ",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
165! For a surface 2D Variable
166!--------------------------
167
168        else if (dim.eq.2) then
169
170!         Ecriture du champs
171
172           ierr= NF_INQ_VARID(nid,nom,varid)
173           if (ierr /= NF_NOERR) then
174!  choix du nom des coordonnees
175              ierr= NF_INQ_DIMID(nid,"longitude",id(1))
176              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
177              ierr= NF_INQ_DIMID(nid,"Time",id(3))
178
179! Creation de la variable si elle n'existait pas
180
181              write (*,*) "====================="
182              write (*,*) "creation de ",nom
183
184              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
185
186           endif
187
188           corner(1)=1
189           corner(2)=1
190           corner(3)=ntime
191           edges(1)=iip1
192           edges(2)=jjp1
193           edges(3)=1
194
195
196#ifdef NC_DOUBLE
197           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
198#else         
199           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
200#endif     
201
202           if (ierr.ne.NF_NOERR) then
203              write(*,*) "***** PUT_VAR matter in write_archive"
204              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
205              call abort
206           endif
207
208
209!Cas Variable 0D (scalaire dependant du temps)
210!---------------------------------------------
211
212        else if (dim.eq.0) 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,"Time",id(1))
220
221! Creation de la variable si elle n'existait pas
222
223              write (*,*) "====================="
224              write (*,*) "creation de ",nom
225
226              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
227
228           endif
229
230           corner(1)=ntime
231           edges(1)=1
232
233#ifdef NC_DOUBLE
234           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
235#else
236           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
237#endif
238           if (ierr.ne.NF_NOERR) then
239              write(*,*) "***** PUT_VAR matter in write_archive"
240              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
241              call abort
242           endif
243
244        else
245          write(*,*) "write_archive: dim=",dim," ?!?"
246          call abort
247        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
248
249      return
250      end
251
Note: See TracBrowser for help on using the repository browser.