/[lmdze]/trunk/libf/dyn3d/dynetat0.f90
ViewVC logotype

Contents of /trunk/libf/dyn3d/dynetat0.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 10 - (show annotations)
Fri Apr 18 14:45:53 2008 UTC (16 years, 1 month ago) by guez
File size: 6507 byte(s) 
Added NetCDF directory "/home/guez/include" in "g95.mk" and
"nag_tools.mk".

Added some "intent" attributes in "PVtheta", "advtrac", "caladvtrac",
"calfis", "diagedyn", "dissip", "vlspltqs", "aeropt", "ajsec",
"calltherm", "clmain", "cltrac", "cltracrn", "concvl", "conema3",
"conflx", "fisrtilp", "newmicro", "nuage", "diagcld1", "diagcld2",
"drag_noro", "lift_noro", "SUGWD", "physiq", "phytrac", "radlwsw", "thermcell".

Removed the case "ierr == 0" in "abort_gcm"; moved call to "histclo"
and messages for end of run from "abort_gcm" to "gcm"; replaced call
to "abort_gcm" in "leapfrog" by exit from outer loop.

In "calfis": removed argument "pp" and variable "unskap"; changed
"pksurcp" from scalar to rank 2; use "pressure_var"; rewrote
computation of "zplev", "zplay", "ztfi", "pcvgt" using "dyn_phy";
added computation of "pls".

Removed unused variable in "dynredem0".

In "exner_hyb": changed "dellta" from scalar to rank 1; replaced call
to "ssum" by call to "sum"; removed variables "xpn" and "xps";
replaced some loops by array expressions.

In "leapfrog": use "pressure_var"; deleted variables "p", "longcles".

Converted common blocks "YOECUMF", "YOEGWD" to modules.

Removed argument "pplay" in "cvltr", "diagetpq", "nflxtr".

Created module "raddimlw" from include file "raddimlw.h".

Corrected call to "new_unit" in "test_disvert".
1 module dynetat0_m
2
3 ! This module is clean: no C preprocessor directive, no include line.
4
5 IMPLICIT NONE
6
7 contains
8
9 SUBROUTINE dynetat0(vcov, ucov, teta, q, masse, ps, phis, time)
10
11 ! From dynetat0.F, version 1.2 2004/06/22 11:45:30
12
13 ! Authors: P. Le Van, L. Fairhead
14 ! Objet : lecture de l'état initial
15
16 use dimens_m, only: iim, jjm, llm, nqmx
17 use comconst, only: im, cpp, dtvr, g, kappa, jm, lllm, omeg, rad
18 use comvert, only: pa
19 use logic, only: fxyhypb, ysinus
20 use comgeom, only: rlonu, rlatu, rlonv, rlatv, cu_2d, cv_2d, aire_2d
21 use serre, only: clon, clat, grossismy, grossismx
22 use temps, only: day_ref, day_ini, itau_dyn, annee_ref
23 use ener, only: etot0, ang0, ptot0, stot0, ztot0
24 use advtrac_m, only: tname
25 use netcdf95, only: nf95_open, nf95_inq_varid, handle_err, NF95_CLOSE
26 use netcdf, only: NF90_NOWRITE, NF90_GET_VAR, NF90_NOERR
27 use nrutil, only: assert
28
29 ! Arguments:
30 REAL, intent(out):: vcov(: , :), ucov(:, :), teta(:, :)
31 REAL, intent(out):: q(:, :, :), masse(:, :)
32 REAL, intent(out):: ps(:) ! in Pa
33 REAL, intent(out):: phis(:, :)
34 REAL, intent(out):: time
35
36 ! Variables
37 INTEGER length, iq
38 PARAMETER (length = 100)
39 REAL tab_cntrl(length) ! tableau des parametres du run
40 INTEGER ierr, nid, nvarid
41
42 !-----------------------------------------------------------------------
43
44 print *, "Call sequence information: dynetat0"
45
46 call assert(size(vcov, 1) == (iim + 1) * jjm, "dynetat0 vcov 1")
47 call assert((/size(ucov, 1), size(teta, 1), size(q, 1), size(masse, 1), &
48 size(ps)/) == (iim + 1) * (jjm + 1), "dynetat0 (iim + 1) * (jjm + 1)")
49 call assert(shape(phis) == (/iim + 1, jjm + 1/), "dynetat0 phis")
50 call assert((/size(vcov, 2), size(ucov, 2), size(teta, 2), size(q, 2), &
51 size(masse, 2)/) == llm, "dynetat0 llm")
52 call assert(size(q, 3) == nqmx, "dynetat0 q 3")
53
54 ! Fichier état initial :
55 call nf95_open("start.nc", NF90_NOWRITE, nid)
56
57 call nf95_inq_varid(nid, "controle", nvarid)
58 ierr = NF90_GET_VAR(nid, nvarid, tab_cntrl)
59 call handle_err("dynetat0, controle", ierr, nid)
60
61 im = int(tab_cntrl(1))
62 jm = int(tab_cntrl(2))
63 lllm = int(tab_cntrl(3))
64 day_ref = int(tab_cntrl(4))
65 annee_ref = int(tab_cntrl(5))
66 omeg = tab_cntrl(7)
67 dtvr = tab_cntrl(12)
68 etot0 = tab_cntrl(13)
69 ptot0 = tab_cntrl(14)
70 ztot0 = tab_cntrl(15)
71 stot0 = tab_cntrl(16)
72 ang0 = tab_cntrl(17)
73 pa = tab_cntrl(18)
74 clon = tab_cntrl(20)
75 clat = tab_cntrl(21)
76 grossismx = tab_cntrl(22)
77 grossismy = tab_cntrl(23)
78
79 IF (tab_cntrl(24) == 1.) THEN
80 fxyhypb = .TRUE.
81 ELSE
82 fxyhypb = .FALSE.
83 ysinus = .FALSE.
84 IF (tab_cntrl(27) == 1.) ysinus = .TRUE.
85 ENDIF
86
87 day_ini = tab_cntrl(30)
88 itau_dyn = tab_cntrl(31)
89
90 PRINT *, 'rad = ', rad
91 PRINT *, 'omeg = ', omeg
92 PRINT *, 'g = ', g
93 PRINT *, 'cpp = ', cpp
94 PRINT *, 'kappa = ', kappa
95
96 IF (im /= iim) THEN
97 PRINT 1, im, iim
98 STOP 1
99 ELSE IF (jm /= jjm) THEN
100 PRINT 2, jm, jjm
101 STOP 1
102 ELSE IF (lllm /= llm) THEN
103 PRINT 3, lllm, llm
104 STOP 1
105 ENDIF
106
107 call NF95_INQ_VARID (nid, "rlonu", nvarid)
108 ierr = NF90_GET_VAR(nid, nvarid, rlonu)
109 call handle_err("dynetat0, rlonu", ierr, nid)
110
111 call NF95_INQ_VARID (nid, "rlatu", nvarid)
112 ierr = NF90_GET_VAR(nid, nvarid, rlatu)
113 call handle_err("dynetat0, rlatu", ierr, nid)
114
115 call NF95_INQ_VARID (nid, "rlonv", nvarid)
116 ierr = NF90_GET_VAR(nid, nvarid, rlonv)
117 call handle_err("dynetat0, rlonv", ierr, nid)
118
119 call NF95_INQ_VARID (nid, "rlatv", nvarid)
120 ierr = NF90_GET_VAR(nid, nvarid, rlatv)
121 call handle_err("dynetat0, rlatv", ierr, nid)
122
123 call NF95_INQ_VARID (nid, "cu", nvarid)
124 ierr = NF90_GET_VAR(nid, nvarid, cu_2d)
125 call handle_err("dynetat0, cu", ierr, nid)
126
127 call NF95_INQ_VARID (nid, "cv", nvarid)
128 ierr = NF90_GET_VAR(nid, nvarid, cv_2d)
129 call handle_err("dynetat0, cv", ierr, nid)
130
131 call NF95_INQ_VARID (nid, "aire", nvarid)
132 ierr = NF90_GET_VAR(nid, nvarid, aire_2d)
133 call handle_err("dynetat0, aire", ierr, nid)
134
135 call NF95_INQ_VARID (nid, "phisinit", nvarid)
136 ierr = NF90_GET_VAR(nid, nvarid, phis)
137 call handle_err("dynetat0, phisinit", ierr, nid)
138
139 call NF95_INQ_VARID (nid, "temps", nvarid)
140 ierr = NF90_GET_VAR(nid, nvarid, time)
141 call handle_err("dynetat0, temps", ierr, nid)
142
143 call NF95_INQ_VARID (nid, "ucov", nvarid)
144 ierr = NF90_GET_VAR(nid, nvarid, ucov, count=(/iim + 1, jjm + 1, llm/))
145 call handle_err("dynetat0, ucov", ierr, nid)
146
147 call NF95_INQ_VARID (nid, "vcov", nvarid)
148 ierr = NF90_GET_VAR(nid, nvarid, vcov, count=(/iim + 1, jjm, llm/))
149 call handle_err("dynetat0, vcov", ierr, nid)
150
151 call NF95_INQ_VARID (nid, "teta", nvarid)
152 ierr = NF90_GET_VAR(nid, nvarid, teta, count=(/iim + 1, jjm + 1, llm/))
153 call handle_err("dynetat0, teta", ierr, nid)
154
155 DO iq = 1, nqmx
156 call NF95_INQ_VARID(nid, tname(iq), nvarid, ierr)
157 IF (ierr /= NF90_NOERR) THEN
158 PRINT *, 'dynetat0: le champ "' // tname(iq) // '" est absent, ' // &
159 "il est donc initialisé à zéro."
160 q(:, :, iq) = 0.
161 ELSE
162 ierr = NF90_GET_VAR(nid, nvarid, q(:, :, iq), &
163 count=(/iim + 1, jjm + 1, llm/))
164 call handle_err("dynetat0, " // tname(iq), ierr, nid)
165 ENDIF
166 ENDDO
167
168 call NF95_INQ_VARID (nid, "masse", nvarid)
169 ierr = NF90_GET_VAR(nid, nvarid, masse, count=(/iim + 1, jjm + 1, llm/))
170 call handle_err("dynetat0, masse", ierr, nid)
171
172 call NF95_INQ_VARID (nid, "ps", nvarid)
173 ierr = NF90_GET_VAR(nid, nvarid, ps, count=(/iim + 1, jjm + 1/))
174 call handle_err("dynetat0, ps", ierr, nid)
175
176 call NF95_CLOSE(nid)
177
178 day_ini=day_ini+INT(time)
179 time=time-INT(time)
180
181 1 FORMAT(//10x, 'la valeur de im =', i4, 2x, &
182 'lue sur le fichier de demarrage est differente de la valeur ' &
183 // 'parametree iim =', i4//)
184 2 FORMAT(//10x, 'la valeur de jm =', i4, 2x, &
185 'lue sur le fichier de demarrage est differente de la valeur ' &
186 // 'parametree jjm =', i4//)
187 3 FORMAT(//10x, 'la valeur de lmax =', i4, 2x, &
188 'lue sur le fichier demarrage est differente de la valeur ' &
189 // 'parametree llm =', i4//)
190
191 END SUBROUTINE dynetat0
192
193 end module dynetat0_m
  ViewVC Help
Powered by ViewVC 1.1.21