source: trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/write_archive.F @ 1711

Last change on this file since 1711 was 1422, checked in by milmd, 10 years ago

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