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

Last change on this file since 3532 was 3100, checked in by bhatnags, 16 months ago

Generic-PCM

This commit updates the slab ocean module to a parallelisable dynamic slab ocean module. This is particularly relevant if you want to be able to use oceanic heat transport in parallel mode.

It has the following features:

(a) Computes sea ice creation and evolution.
(b) Snow has thermodynamic properties.
(c) Computes oceanic horizontal transport (diffusion & surface-wind driven Ekman transport).
(d) Can be used in parallel mode.

Required callphys.def flags:
The slab ocean and its dependencies can be activated with the following flags (already added to deftank):
## Ocean options
## ~
# Model slab-ocean (Main flag for slab ocean)
ok_slab_ocean = .true.
# The following flags can only be set to true if ok_slab_ocean is true
# Ekman transport
slab_ekman = .true.
# Ekman zonal advection
slab_ekman_zonadv = .true.
# Horizontal diffusion (default coef_hdiff=25000., can be changed)
slab_hdiff = .true.
# Slab-ocean timestep (in physics timesteps)
cpl_pas = 1
# Gent-McWilliams? Scheme (can only be true if slab_ekman is true)
slab_gm = .true.

Notes:
In the current state, the model crashes if moistadjustment = .true. Unsure whether this is due to the slab or is an inherent issue with moistadj (under investigation).

SB and EM
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(4)=1
200#ifdef NC_DOUBLE
201           ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,px)
202#else
203           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
204#endif
205
206
207
208! For a surface 2D Variable
209!--------------------------
210
211        else if (dim.eq.2) 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,"longitude",id(1))
219              ierr= NF_INQ_DIMID(nid,"latitude",id(2))
220              ierr= NF_INQ_DIMID(nid,"Time",id(3))
221
222! Creation de la variable si elle n'existait pas
223
224              write (*,*) "====================="
225              write (*,*) "defining variable ",trim(nom)
226
227              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
228
229           endif
230
231           corner(1)=1
232           corner(2)=1
233           corner(3)=ntime
234           edges(1)=iip1
235           edges(2)=jjp1
236           edges(3)=1
237
238
239#ifdef NC_DOUBLE
240           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
241#else         
242           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
243#endif     
244
245           if (ierr.ne.NF_NOERR) then
246              write(*,*) "***** PUT_VAR problem in write_archive"
247              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
248              call abort
249           endif
250
251
252!Cas Variable 0D (scalaire dependant du temps)
253!---------------------------------------------
254
255        else if (dim.eq.0) then
256
257!         Ecriture du champs
258
259           ierr= NF_INQ_VARID(nid,nom,varid)
260           if (ierr /= NF_NOERR) then
261!  choix du nom des coordonnees
262              ierr= NF_INQ_DIMID(nid,"Time",id(1))
263
264! Creation de la variable si elle n'existait pas
265
266              write (*,*) "====================="
267              write (*,*) "defining variable ",trim(nom)
268
269              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
270
271           endif
272
273           corner(1)=ntime
274           edges(1)=1
275
276#ifdef NC_DOUBLE
277           ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,px)
278#else
279           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
280#endif
281           if (ierr.ne.NF_NOERR) then
282              write(*,*) "***** PUT_VAR problem in write_archive"
283              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
284              call abort
285           endif
286
287        else
288          write(*,*) "write_archive: dim=",dim," ?!?"
289          call abort
290        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
291
292      end
293
Note: See TracBrowser for help on using the repository browser.