/[lmdze]/trunk/dyn3d/dynetat0.f
ViewVC logotype

Diff of /trunk/dyn3d/dynetat0.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/dynetat0.f90 revision 7 by guez, Mon Mar 31 12:24:17 2008 UTC trunk/dyn3d/dynetat0.f revision 259 by guez, Tue Mar 6 16:19:52 2018 UTC
# Line 1  Line 1 
1  module dynetat0_m  module dynetat0_m
2    
3    ! This module is clean: no C preprocessor directive, no include line.    use dimens_m, only: iim, jjm
4    
5    IMPLICIT NONE    IMPLICIT NONE
6    
7  contains    private iim, jjm
8    
9      INTEGER day_ini
10      ! day number at the beginning of the run, based at value 1 on
11      ! January 1st of annee_ref
12    
13      integer:: day_ref = 1 ! jour de l'ann\'ee de l'\'etat initial
14      ! (= 350 si 20 d\'ecembre par exemple)
15    
16      integer:: annee_ref = 1998 ! Annee de l'etat initial (avec 4 chiffres)
17    
18      REAL clon ! longitude of the center of the zoom, in rad
19      real clat ! latitude of the center of the zoom, in rad
20    
21      real grossismx, grossismy
22      ! facteurs de grossissement du zoom, selon la longitude et la latitude
23      ! = 2 si 2 fois, = 3 si 3 fois, etc.
24    
25      real dzoomx, dzoomy
26      ! extensions en longitude et latitude de la zone du zoom (fractions
27      ! de la zone totale)
28    
29      real taux, tauy
30      ! raideur de la transition de l'int\'erieur \`a l'ext\'erieur du zoom
31      
32      real rlatu(jjm + 1)
33      ! latitudes of points of the "scalar" and "u" grid, in rad
34    
35      real rlatv(jjm)
36      ! latitudes of points of the "v" grid, in rad, in decreasing order
37    
38      real rlonu(iim + 1) ! longitudes of points of the "u" grid, in rad
39    
40    SUBROUTINE dynetat0(vcov, ucov, teta, q, masse, ps, phis, time)    real rlonv(iim + 1)
41      ! longitudes of points of the "scalar" and "v" grid, in rad
42    
43      ! From dynetat0.F, version 1.2 2004/06/22 11:45:30    real xprimu(iim + 1), xprimv(iim + 1)
44      ! 2 pi / iim * (derivative of the longitudinal zoom function)(rlon[uv])
45    
46      ! Authors:  P. Le Van, L. Fairhead    REAL xprimm025(iim + 1), xprimp025(iim + 1)
47      ! Objet : lecture de l'état initial    REAL rlatu1(jjm), rlatu2(jjm), yprimu1(jjm), yprimu2(jjm)
48      REAL ang0, etot0, ptot0, ztot0, stot0
49    
50      save
51    
52    contains
53    
54      SUBROUTINE dynetat0(vcov, ucov, teta, q, masse, ps, phis)
55    
56        ! From dynetat0.F, version 1.2, 2004/06/22 11:45:30
57        ! Authors: P. Le Van, L. Fairhead
58        ! This procedure reads the initial state of the atmosphere.
59    
60        use comconst, only: dtvr
61        use conf_gcm_m, only: raz_date
62      use dimens_m, only: iim, jjm, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
63      use comconst, only: im, cpp, dtvr, g, kappa, jm, lllm, omeg, rad      use disvert_m, only: pa
64      use comvert, only: pa      use iniadvtrac_m, only: tname
65      use logic, only: fxyhypb, ysinus      use netcdf, only: NF90_NOWRITE, NF90_NOERR
66      use comgeom, only: rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d      use netcdf95, only: NF95_GET_VAR, nf95_open, nf95_inq_varid, NF95_CLOSE, &
67      use serre, only: clon, clat, grossismy, grossismx           NF95_Gw_VAR
68      use temps, only: day_ref, day_ini, itau_dyn, annee_ref      use nr_util, only: assert
69      use ener, only: etot0, ang0, ptot0, stot0, ztot0      use temps, only: itau_dyn
70      use advtrac_m, only: tname      use unit_nml_m, only: unit_nml
71      use netcdf95, only: nf95_open, NF90_NOWRITE, nf95_inq_varid, &  
72           NF90_GET_VAR, handle_err, NF90_NOERR, NF95_CLOSE      REAL, intent(out):: vcov(: , :, :) ! (iim + 1, jjm, llm)
73      use nrutil, only: assert      REAL, intent(out):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
74        REAL, intent(out):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
75      !   Arguments:      REAL, intent(out):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
76      REAL, intent(out):: vcov(: , :), ucov(:, :), teta(:, :)      REAL, intent(out):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
77      REAL, intent(out):: q(:, :, :), masse(:, :)      REAL, intent(out):: ps(:, :) ! (iim + 1, jjm + 1) in Pa
78      REAL, intent(out):: ps(:), phis(:, :)      REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
79      REAL, intent(out):: time  
80        ! Local variables:
81      !   Variables      INTEGER iq
82      INTEGER length, iq      REAL, allocatable:: tab_cntrl(:) ! tableau des param\`etres du run
83      PARAMETER (length = 100)      INTEGER ierr, ncid, varid
84      REAL tab_cntrl(length) ! tableau des parametres du run  
85      INTEGER ierr, nid, nvarid      namelist /dynetat0_nml/ day_ref, annee_ref
86    
87      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
88    
89      print *, "Call sequence information: dynetat0"      print *, "Call sequence information: dynetat0"
90    
91      call assert(size(vcov, 1) == (iim + 1) * jjm, "dynetat0 vcov 1")      call assert((/size(ucov, 1), size(vcov, 1), size(masse, 1), size(ps, 1), &
92      call assert((/size(ucov, 1), size(teta, 1), size(q, 1), size(masse, 1), &           size(phis, 1), size(q, 1), size(teta, 1)/) == iim + 1, "dynetat0 iim")
93           size(ps)/) == (iim + 1) * (jjm + 1), "dynetat0 (iim + 1) * (jjm + 1)")      call assert((/size(ucov, 2), size(vcov, 2) + 1, size(masse, 2), &
94      call assert(shape(phis) == (/iim + 1, jjm + 1/), "dynetat0 phis")           size(ps, 2), size(phis, 2), size(q, 2), size(teta, 2)/) == jjm + 1, &
95      call assert((/size(vcov, 2), size(ucov, 2), size(teta, 2), size(q, 2), &           "dynetat0 jjm")
96           size(masse, 2)/) == llm, "dynetat0 llm")      call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(q, 3), &
97      call assert(size(q, 3) == nqmx, "dynetat0 q 3")           size(masse, 3)/) == llm, "dynetat0 llm")
98        call assert(size(q, 4) == nqmx, "dynetat0 q nqmx")
99      ! Fichier état initial :  
100      call nf95_open("start.nc", NF90_NOWRITE, nid)      ! Fichier \'etat initial :
101        call nf95_open("start.nc", NF90_NOWRITE, ncid)
102      call nf95_inq_varid(nid, "controle", nvarid)  
103      ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)      call nf95_inq_varid(ncid, "controle", varid)
104      call handle_err("dynetat0, controle", ierr, nid)      call NF95_Gw_VAR(ncid, varid, tab_cntrl)
105    
106      im         = int(tab_cntrl(1))      call assert(int(tab_cntrl(1)) == iim, "dynetat0 tab_cntrl iim")
107      jm         = int(tab_cntrl(2))      call assert(int(tab_cntrl(2)) == jjm, "dynetat0 tab_cntrl jjm")
108      lllm       = int(tab_cntrl(3))      call assert(int(tab_cntrl(3)) == llm, "dynetat0 tab_cntrl llm")
109      day_ref    = int(tab_cntrl(4))  
110      annee_ref  = int(tab_cntrl(5))      IF (dtvr /= tab_cntrl(12)) THEN
111      omeg       = tab_cntrl(7)         print *, 'Warning: the time steps from day_step and "start.nc" ' // &
112      dtvr       = tab_cntrl(12)              'are different.'
113      etot0      = tab_cntrl(13)         print *, 'dtvr from day_step: ', dtvr
114      ptot0      = tab_cntrl(14)         print *, 'dtvr from "start.nc": ', tab_cntrl(12)
115      ztot0      = tab_cntrl(15)         print *, 'Using the value from day_step.'
     stot0      = tab_cntrl(16)  
     ang0       = tab_cntrl(17)  
     pa         = tab_cntrl(18)  
     clon       = tab_cntrl(20)  
     clat       = tab_cntrl(21)  
     grossismx  = tab_cntrl(22)  
     grossismy  = tab_cntrl(23)  
   
     IF (tab_cntrl(24) == 1.)  THEN  
        fxyhypb  = .TRUE.  
     ELSE  
        fxyhypb = .FALSE.  
        ysinus  = .FALSE.  
        IF (tab_cntrl(27) == 1.) ysinus = .TRUE.  
116      ENDIF      ENDIF
117    
118      day_ini = tab_cntrl(30)      etot0 = tab_cntrl(13)
119      itau_dyn = tab_cntrl(31)      ptot0 = tab_cntrl(14)
120        ztot0 = tab_cntrl(15)
121        stot0 = tab_cntrl(16)
122        ang0 = tab_cntrl(17)
123        pa = tab_cntrl(18)
124    
125        clon = tab_cntrl(20)
126        clat = tab_cntrl(21)
127        grossismx = tab_cntrl(22)
128        grossismy = tab_cntrl(23)
129        dzoomx = tab_cntrl(25)
130        dzoomy = tab_cntrl(26)
131        taux = tab_cntrl(28)
132        tauy = tab_cntrl(29)
133    
134        print *, "Enter namelist 'dynetat0_nml'."
135        read(unit=*, nml=dynetat0_nml)
136        write(unit_nml, nml=dynetat0_nml)
137    
138        if (raz_date) then
139           print *, 'Resetting the date, using the namelist.'
140           day_ini = day_ref
141           itau_dyn = 0
142        else
143           day_ref = tab_cntrl(4)
144           annee_ref = tab_cntrl(5)
145           itau_dyn = tab_cntrl(31)
146           day_ini = tab_cntrl(30)
147        end if
148    
149        print *, "day_ini = ", day_ini
150    
151        call NF95_INQ_VARID (ncid, "rlonu", varid)
152        call NF95_GET_VAR(ncid, varid, rlonu)
153    
154        call NF95_INQ_VARID (ncid, "rlatu", varid)
155        call NF95_GET_VAR(ncid, varid, rlatu)
156    
157        call NF95_INQ_VARID (ncid, "rlonv", varid)
158        call NF95_GET_VAR(ncid, varid, rlonv)
159    
160        call NF95_INQ_VARID (ncid, "rlatv", varid)
161        call NF95_GET_VAR(ncid, varid, rlatv)
162    
163        CALL nf95_inq_varid(ncid, 'xprimu', varid)
164        CALL nf95_get_var(ncid, varid, xprimu)
165    
166        CALL nf95_inq_varid(ncid, 'xprimv', varid)
167        CALL nf95_get_var(ncid, varid, xprimv)
168    
169        CALL nf95_inq_varid(ncid, 'xprimm025', varid)
170        CALL nf95_get_var(ncid, varid, xprimm025)
171    
172        CALL nf95_inq_varid(ncid, 'xprimp025', varid)
173        CALL nf95_get_var(ncid, varid, xprimp025)
174    
175        call NF95_INQ_VARID (ncid, "rlatu1", varid)
176        call NF95_GET_VAR(ncid, varid, rlatu1)
177    
178        call NF95_INQ_VARID (ncid, "rlatu2", varid)
179        call NF95_GET_VAR(ncid, varid, rlatu2)
180    
181        CALL nf95_inq_varid(ncid, 'yprimu1', varid)
182        CALL nf95_get_var(ncid, varid, yprimu1)
183    
184        CALL nf95_inq_varid(ncid, 'yprimu2', varid)
185        CALL nf95_get_var(ncid, varid, yprimu2)
186    
187        call NF95_INQ_VARID (ncid, "phis", varid)
188        call NF95_GET_VAR(ncid, varid, phis)
189    
190      PRINT *, 'rad = ', rad      call NF95_INQ_VARID (ncid, "ucov", varid)
191      PRINT *, 'omeg = ', omeg      call NF95_GET_VAR(ncid, varid, ucov)
192      PRINT *, 'g = ', g  
193      PRINT *, 'cpp = ', cpp      call NF95_INQ_VARID (ncid, "vcov", varid)
194      PRINT *, 'kappa = ', kappa      call NF95_GET_VAR(ncid, varid, vcov)
   
     IF (im /= iim)  THEN  
        PRINT 1, im, iim  
        STOP 1  
     ELSE  IF (jm /= jjm)  THEN  
        PRINT 2, jm, jjm  
        STOP 1  
     ELSE  IF (lllm /= llm)  THEN  
        PRINT 3, lllm, llm  
        STOP 1  
     ENDIF  
195    
196      call NF95_INQ_VARID (nid, "rlonu", nvarid)      call NF95_INQ_VARID (ncid, "teta", varid)
197      ierr = NF90_GET_VAR(nid, nvarid, rlonu)      call NF95_GET_VAR(ncid, varid, teta)
     call handle_err("dynetat0, rlonu", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "rlatu", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, rlatu)  
     call handle_err("dynetat0, rlatu", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "rlonv", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, rlonv)  
     call handle_err("dynetat0, rlonv", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "rlatv", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, rlatv)  
     call handle_err("dynetat0, rlatv", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "cu", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, cu_2d)  
     call handle_err("dynetat0, cu", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "cv", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, cv_2d)  
     call handle_err("dynetat0, cv", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "aire", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, aire_2d)  
     call handle_err("dynetat0, aire", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "phisinit", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, phis)  
     call handle_err("dynetat0, phisinit", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "temps", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, time)  
     call handle_err("dynetat0, temps", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "ucov", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, ucov, count=(/iim + 1, jjm + 1, llm/))  
     call handle_err("dynetat0, ucov", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "vcov", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, vcov, count=(/iim + 1, jjm, llm/))  
     call handle_err("dynetat0, vcov", ierr, nid)  
   
     call NF95_INQ_VARID (nid, "teta", nvarid)  
     ierr = NF90_GET_VAR(nid, nvarid, teta, count=(/iim + 1, jjm + 1, llm/))  
     call handle_err("dynetat0, teta", ierr, nid)  
198    
199      DO iq = 1, nqmx      DO iq = 1, nqmx
200         call NF95_INQ_VARID(nid, tname(iq), nvarid, ierr)         call NF95_INQ_VARID(ncid, tname(iq), varid, ierr)
201         IF (ierr  /=  NF90_NOERR) THEN         IF (ierr == NF90_NOERR) THEN
202            PRINT *, 'dynetat0: le champ "' // tname(iq) // '" est absent, ' // &            call NF95_GET_VAR(ncid, varid, q(:, :, :, iq))
                "il est donc initialisé ŕ zéro."  
           q(:, :, iq) = 0.  
203         ELSE         ELSE
204            ierr = NF90_GET_VAR(nid, nvarid, q(:, :, iq), &            PRINT *, 'dynetat0: "' // tname(iq) // '" not found, ' // &
205                 count=(/iim + 1, jjm + 1, llm/))                 "setting it to zero..."
206            call handle_err("dynetat0, " // tname(iq), ierr, nid)            q(:, :, :, iq) = 0.
207         ENDIF         ENDIF
208      ENDDO      ENDDO
209    
210      call NF95_INQ_VARID (nid, "masse", nvarid)      call NF95_INQ_VARID (ncid, "masse", varid)
211      ierr = NF90_GET_VAR(nid, nvarid, masse, count=(/iim + 1, jjm + 1, llm/))      call NF95_GET_VAR(ncid, varid, masse)
212      call handle_err("dynetat0, masse", ierr, nid)  
213        call NF95_INQ_VARID (ncid, "ps", varid)
214      call NF95_INQ_VARID (nid, "ps", nvarid)      call NF95_GET_VAR(ncid, varid, ps)
215      ierr = NF90_GET_VAR(nid, nvarid, ps, count=(/iim + 1, jjm + 1/))      ! Check that there is a single value at each pole:
216      call handle_err("dynetat0, ps", ierr, nid)      call assert(ps(1, 1) == ps(2:, 1), "dynetat0 ps north pole")
217        call assert(ps(1, jjm + 1) == ps(2:, jjm + 1), "dynetat0 ps south pole")
218      call NF95_CLOSE(nid)  
219        call NF95_CLOSE(ncid)
     day_ini=day_ini+INT(time)  
     time=time-INT(time)  
   
 1   FORMAT(//10x, 'la valeur de im =', i4, 2x, &  
          'lue sur le fichier de demarrage est differente de la valeur ' &  
          // 'parametree iim =', i4//)  
 2   FORMAT(//10x, 'la valeur de jm =', i4, 2x, &  
          'lue sur le fichier de demarrage est differente de la valeur ' &  
          // 'parametree jjm =', i4//)  
 3   FORMAT(//10x, 'la valeur de lmax =', i4, 2x, &  
          'lue sur le fichier demarrage est differente de la valeur ' &  
          // 'parametree llm =', i4//)  
220    
221    END SUBROUTINE dynetat0    END SUBROUTINE dynetat0
222    
Legend:
Removed from v.7  
changed lines
  Added in v.259
  ViewVC Help
Powered by ViewVC 1.1.21