source: trunk/LMDZ.PLUTO.old/libf/dyn3d/dynetat0.F @ 3436

Last change on this file since 3436 was 3175, checked in by emillour, 11 months ago

Pluto PCM:
Add the old Pluto LMDZ for reference (required prior step to making
an LMDZ.PLUTO using the same framework as the other physics packages).
TB+EM
File size: 12.4 KB
RevLine 
[3175]1      SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
2     .                    teta,q,masse,ps,phis,time)
3      IMPLICIT NONE
4
5c=======================================================================
6c
7c   Auteur:  P. Le Van / L.Fairhead
8c   -------
9c
10c   objet:
11c   ------
12c
13c   Lecture de l'etat initial
14c
15c   Modifs: Oct.2008 read in tracers by name. Ehouarn Millour
16c
17c=======================================================================
18c-----------------------------------------------------------------------
19c   Declarations:
20c   -------------
21
22#include "dimensions.h"
23#include "paramet.h"
24#include "temps.h"
25#include "comconst.h"
26#include "comvert.h"
27#include "comgeom.h"
28#include "ener.h"
29#include "netcdf.inc"
30#include "description.h"
31#include "serre.h"
32#include "logic.h"
33#include"advtrac.h"
34
35c   Arguments:
36c   ----------
37
38      CHARACTER*(*) fichnom
39      INTEGER nq
40      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
41      REAL q(iip1,jjp1,llm,nq),masse(ip1jmp1,llm)
42      REAL ps(ip1jmp1),phis(ip1jmp1)
43
44      REAL time
45
46c   Variables
47c
48      INTEGER length,iq,i,j,l
49      PARAMETER (length = 100)
50      REAL tab_cntrl(length) ! tableau des parametres du run
51      INTEGER ierr, nid, nvarid, nqold
52      CHARACTER  str3*3,yes*1
53
54c-----------------------------------------------------------------------
55
56c  Ouverture NetCDF du fichier etat initial
57
58      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
59      IF (ierr.NE.NF_NOERR) THEN
60        write(6,*)' Pb d''ouverture du fichier ',fichnom
61        CALL ABORT
62      ENDIF
63
64c
65      ierr = NF_INQ_VARID (nid, "controle", nvarid)
66      IF (ierr .NE. NF_NOERR) THEN
67         PRINT*, "dynetat0: Le champ <controle> est absent"
68         CALL abort
69      ENDIF
70#ifdef NC_DOUBLE
71      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
72#else
73      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
74#endif
75      IF (ierr .NE. NF_NOERR) THEN
76         PRINT*, "dynetat0: Lecture echoue pour <controle>"
77         CALL abort
78      ENDIF
79
80      im         = tab_cntrl(1)
81      jm         = tab_cntrl(2)
82      lllm       = tab_cntrl(3)
83      day_ini    = tab_cntrl(4)
84      rad        = tab_cntrl(5)
85      omeg       = tab_cntrl(6)
86      g          = tab_cntrl(7)
87      cpp        = tab_cntrl(8)
88      kappa      = tab_cntrl(9)
89      daysec     = tab_cntrl(10)
90      dtvr       = tab_cntrl(11)
91      etot0      = tab_cntrl(12)
92      ptot0      = tab_cntrl(13)
93      ztot0      = tab_cntrl(14)
94      stot0      = tab_cntrl(15)
95      ang0       = tab_cntrl(16)
96      pa         = tab_cntrl(17)
97      preff      = tab_cntrl(18)
98c
99      clon       = tab_cntrl(19)
100      clat       = tab_cntrl(20)
101      grossismx  = tab_cntrl(21)
102      grossismy  = tab_cntrl(22)
103c
104      IF ( tab_cntrl(23).EQ.1. )  THEN
105        fxyhypb  = . TRUE .
106        dzoomx   = tab_cntrl(24)
107        dzoomy   = tab_cntrl(25)
108        taux     = tab_cntrl(27)
109        tauy     = tab_cntrl(28)
110      ELSE
111        fxyhypb = . FALSE .
112        ysinus  = . FALSE .
113        IF( tab_cntrl(26).EQ.1. ) ysinus = . TRUE.
114      ENDIF
115c   .................................................................
116c
117c
118      PRINT*,'dynetat0: in start.nc:'
119      PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
120 
121      IF(   im.ne.iim           )  THEN
122          PRINT 1,im,iim
123          STOP
124      ELSE  IF( jm.ne.jjm       )  THEN
125          PRINT 2,jm,jjm
126          STOP
127      ELSE  IF( lllm.ne.llm     )  THEN
128          PRINT 3,lllm,llm
129          STOP
130      ENDIF
131
132      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
133      IF (ierr .NE. NF_NOERR) THEN
134         PRINT*, "dynetat0: Le champ <rlonu> est absent"
135         CALL abort
136      ENDIF
137#ifdef NC_DOUBLE
138      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
139#else
140      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
141#endif
142      IF (ierr .NE. NF_NOERR) THEN
143         PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
144         CALL abort
145      ENDIF
146
147      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
148      IF (ierr .NE. NF_NOERR) THEN
149         PRINT*, "dynetat0: Le champ <rlatu> est absent"
150         CALL abort
151      ENDIF
152#ifdef NC_DOUBLE
153      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
154#else
155      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
156#endif
157      IF (ierr .NE. NF_NOERR) THEN
158         PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
159         CALL abort
160      ENDIF
161
162      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
163      IF (ierr .NE. NF_NOERR) THEN
164         PRINT*, "dynetat0: Le champ <rlonv> est absent"
165         CALL abort
166      ENDIF
167#ifdef NC_DOUBLE
168      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
169#else
170      ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
171#endif
172      IF (ierr .NE. NF_NOERR) THEN
173         PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
174         CALL abort
175      ENDIF
176
177      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
178      IF (ierr .NE. NF_NOERR) THEN
179         PRINT*, "dynetat0: Le champ <rlatv> est absent"
180         CALL abort
181      ENDIF
182#ifdef NC_DOUBLE
183      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
184#else
185      ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
186#endif
187      IF (ierr .NE. NF_NOERR) THEN
188         PRINT*, "dynetat0: Lecture echouee pour rlatv"
189         CALL abort
190      ENDIF
191
192      ierr = NF_INQ_VARID (nid, "cu", nvarid)
193      IF (ierr .NE. NF_NOERR) THEN
194         PRINT*, "dynetat0: Le champ <cu> est absent"
195         CALL abort
196      ENDIF
197#ifdef NC_DOUBLE
198      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
199#else
200      ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
201#endif
202      IF (ierr .NE. NF_NOERR) THEN
203         PRINT*, "dynetat0: Lecture echouee pour <cu>"
204         CALL abort
205      ENDIF
206
207      ierr = NF_INQ_VARID (nid, "cv", nvarid)
208      IF (ierr .NE. NF_NOERR) THEN
209         PRINT*, "dynetat0: Le champ <cv> est absent"
210         CALL abort
211      ENDIF
212#ifdef NC_DOUBLE
213      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
214#else
215      ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
216#endif
217      IF (ierr .NE. NF_NOERR) THEN
218         PRINT*, "dynetat0: Lecture echouee pour <cv>"
219         CALL abort
220      ENDIF
221
222      ierr = NF_INQ_VARID (nid, "aire", nvarid)
223      IF (ierr .NE. NF_NOERR) THEN
224         PRINT*, "dynetat0: Le champ <aire> est absent"
225         CALL abort
226      ENDIF
227#ifdef NC_DOUBLE
228      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
229#else
230      ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
231#endif
232      IF (ierr .NE. NF_NOERR) THEN
233         PRINT*, "dynetat0: Lecture echouee pour <aire>"
234         CALL abort
235      ENDIF
236
237      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
238      IF (ierr .NE. NF_NOERR) THEN
239         PRINT*, "dynetat0: Le champ <phisinit> est absent"
240         CALL abort
241      ENDIF
242#ifdef NC_DOUBLE
243      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis)
244#else
245      ierr = NF_GET_VAR_REAL(nid, nvarid, phis)
246#endif
247      IF (ierr .NE. NF_NOERR) THEN
248         PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
249         CALL abort
250      ENDIF
251
252      ierr = NF_INQ_VARID (nid, "Time", nvarid)
253      IF (ierr .NE. NF_NOERR) THEN
254             ierr = NF_INQ_VARID (nid, "temps", nvarid)
255                 IF (ierr .NE. NF_NOERR) THEN
256           PRINT*, "dynetat0: <Time> or <temps> absent"
257           CALL abort
258         ENDIF
259      ENDIF
260#ifdef NC_DOUBLE
261      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
262#else
263      ierr = NF_GET_VAR_REAL(nid, nvarid, time)
264#endif
265      IF (ierr .NE. NF_NOERR) THEN
266         PRINT*, "dynetat0: Lecture echouee <Time>/<temps>"
267         CALL abort
268      ENDIF
269
270      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
271      IF (ierr .NE. NF_NOERR) THEN
272         PRINT*, "dynetat0: Le champ <ucov> est absent"
273         CALL abort
274      ENDIF
275#ifdef NC_DOUBLE
276      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov)
277#else
278      ierr = NF_GET_VAR_REAL(nid, nvarid, ucov)
279#endif
280      IF (ierr .NE. NF_NOERR) THEN
281         PRINT*, "dynetat0: Lecture echouee pour <ucov>"
282         CALL abort
283      ENDIF
284 
285      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
286      IF (ierr .NE. NF_NOERR) THEN
287         PRINT*, "dynetat0: Le champ <vcov> est absent"
288         CALL abort
289      ENDIF
290#ifdef NC_DOUBLE
291      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov)
292#else
293      ierr = NF_GET_VAR_REAL(nid, nvarid, vcov)
294#endif
295      IF (ierr .NE. NF_NOERR) THEN
296         PRINT*, "dynetat0: Lecture echouee pour <vcov>"
297         CALL abort
298      ENDIF
299
300      ierr = NF_INQ_VARID (nid, "teta", nvarid)
301      IF (ierr .NE. NF_NOERR) THEN
302         PRINT*, "dynetat0: Le champ <teta> est absent"
303         CALL abort
304      ENDIF
305#ifdef NC_DOUBLE
306      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta)
307#else
308      ierr = NF_GET_VAR_REAL(nid, nvarid, teta)
309#endif
310      IF (ierr .NE. NF_NOERR) THEN
311         PRINT*, "dynetat0: Lecture echouee pour <teta>"
312         CALL abort
313      ENDIF
314
315
316      IF(nq.GE.1) THEN
317        write(*,*) 'dynetat0: loading tracers'
318         IF(nq.GT.99) THEN
319            PRINT*, "Trop de traceurs"
320            CALL abort
321         ENDIF
322         nqold=nq
323         DO iq=1,nq
324!           str3(1:1)='q'
325!           WRITE(str3(2:3),'(i2.2)') iq
326!           ierr =  NF_INQ_VARID (nid, str3, nvarid)
327! NB: tracers are now read in using their name ('tnom' from advtrac.h)
328!           write(*,*) "  loading tracer:",trim(tnom(iq))
329           ierr=NF_INQ_VARID(nid,tnom(iq),nvarid)
330           IF (ierr .NE. NF_NOERR) THEN
331!              PRINT*, "dynetat0: Le champ <"//str3//"> est absent"
332              PRINT*, "dynetat0: Le champ <"//trim(tnom(iq))//
333     &                "> est absent"
334              PRINT*, "          Il est donc initialise a zero"
335              CALL initial0(ijp1llm,q(1,1,1,iq))
336              nqold=min(iq-1,nqold)
337           ELSE
338#ifdef NC_DOUBLE
339           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q(1,1,1,iq))
340#else
341           ierr = NF_GET_VAR_REAL(nid, nvarid, q(1,1,1,iq))
342#endif
343             IF (ierr .NE. NF_NOERR) THEN
344!                 PRINT*, "dynetat0: Lecture echouee pour "//str3
345               PRINT*, "dynetat0: Lecture echouee pour "//trim(tnom(iq))
346               CALL abort
347             ENDIF
348           ENDIF
349         ENDDO
350         if ((nqold.lt.nq).and.(nqold.ge.1)) then   
351c        case when new tracer are added in addition to old ones
352             write(*,*)'tracers 1 to ', nqold,'were already present'
353             write(*,*)'tracers ', nqold+1,' to ', nqmx,'are new'
354             write(*,*)' and initialized to zero'
355             q(:,:,:,nqold+1:nqmx)=0.0
356!             yes=' '
357!            do while ((yes.ne.'y').and.(yes.ne.'n'))
358!             write(*,*) 'Would you like to reindex tracer # 1 ->',nqold
359!             write(*,*) 'to #',nqmx-nqold+1,'->', nqmx,'   (y or n) ?'
360!             read(*,fmt='(a)') yes
361!            end do
362!            if (yes.eq.'y') then
363!              write(*,*) 'OK, let s reindex the tracers'
364!              do l=1,llm
365!                do j=1,jjp1
366!                  do i=1,iip1
367!                    do iq=nqmx,nqmx-nqold+1,-1
368!                       q(i,j,l,iq)=q(i,j,l,iq-nqmx+nqold)   
369!                    end do
370!                    do iq=nqmx-nqold,1,-1
371!                       q(i,j,l,iq)= 0.
372!                    end do
373!                  end do
374!                end do
375!              end do
376!            end if
377         end if ! of if ((nqold.lt.nq).and.(nqold.ge.1))
378      ENDIF ! of IF(nq.GE.1)
379
380      ierr = NF_INQ_VARID (nid, "masse", nvarid)
381      IF (ierr .NE. NF_NOERR) THEN
382         PRINT*, "dynetat0: Le champ <masse> est absent"
383         CALL abort
384      ENDIF
385#ifdef NC_DOUBLE
386      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse)
387#else
388      ierr = NF_GET_VAR_REAL(nid, nvarid, masse)
389#endif
390      IF (ierr .NE. NF_NOERR) THEN
391         PRINT*, "dynetat0: Lecture echouee pour <masse>"
392         CALL abort
393      ENDIF
394
395      ierr = NF_INQ_VARID (nid, "ps", nvarid)
396      IF (ierr .NE. NF_NOERR) THEN
397         PRINT*, "dynetat0: Le champ <ps> est absent"
398         CALL abort
399      ENDIF
400#ifdef NC_DOUBLE
401      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps)
402#else
403      ierr = NF_GET_VAR_REAL(nid, nvarid, ps)
404#endif
405      IF (ierr .NE. NF_NOERR) THEN
406         PRINT*, "dynetat0: Lecture echouee pour <ps>"
407         CALL abort
408      ENDIF
409
410      ierr = NF_CLOSE(nid)
411       write(*,*) 'TB15 : dynetat0 : time = ',time
412       day_ini=day_ini+INT(time)
413       time=time-INT(time)
414
415  1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
416     *arrage est differente de la valeur parametree iim =',i4//)
417   2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
418     *arrage est differente de la valeur parametree jjm =',i4//)
419   3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
420     *rrage est differente de la valeur parametree llm =',i4//)
421   4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
422     *rrage est differente de la valeur  dtinteg =',i4//)
423
424      RETURN
425      END
Note: See TracBrowser for help on using the repository browser.