source: LMDZ5/branches/testing/libf/dyn3d/dynetat0.f90 @ 5402

Last change on this file since 5402 was 2870, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2842:2865 into testing branch

File size: 7.2 KB
Line 
1SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
2!
3!-------------------------------------------------------------------------------
4! Authors: P. Le Van , L.Fairhead
5!-------------------------------------------------------------------------------
6! Purpose: Initial state reading.
7!-------------------------------------------------------------------------------
8  USE infotrac
9  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, &
10                         NF90_CLOSE, NF90_GET_VAR
11  USE control_mod, ONLY: planet_type
12  USE assert_eq_m, ONLY: assert_eq
13  USE comvert_mod, ONLY: pa,preff
14  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
15  USE logic_mod, ONLY: fxyhypb, ysinus
16  USE serre_mod, ONLY: clon, clat, grossismx, grossismy
17  USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
18  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
19
20  IMPLICIT NONE
21  include "dimensions.h"
22  include "paramet.h"
23  include "comgeom2.h"
24  include "description.h"
25  include "iniprint.h"
26!===============================================================================
27! Arguments:
28  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
29  REAL, INTENT(OUT) ::  vcov(iip1,jjm, llm)        !--- V COVARIANT WIND
30  REAL, INTENT(OUT) ::  ucov(iip1,jjp1,llm)        !--- U COVARIANT WIND
31  REAL, INTENT(OUT) ::  teta(iip1,jjp1,llm)        !--- POTENTIAL TEMP.
32  REAL, INTENT(OUT) ::     q(iip1,jjp1,llm,nqtot)  !--- TRACERS
33  REAL, INTENT(OUT) :: masse(iip1,jjp1,llm)        !--- MASS PER CELL
34  REAL, INTENT(OUT) ::    ps(iip1,jjp1)            !--- GROUND PRESSURE
35  REAL, INTENT(OUT) ::  phis(iip1,jjp1)            !--- GEOPOTENTIAL
36!===============================================================================
37! Local variables:
38  CHARACTER(LEN=256) :: msg, var, modname
39  INTEGER, PARAMETER :: length=100
40  INTEGER :: iq, fID, vID, idecal!, iml, jml, lml, nqt
41  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
42!-------------------------------------------------------------------------------
43  modname="dynetat0"
44
45!--- Initial state file opening
46  var=fichnom
47  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
48  CALL get_var1("controle",tab_cntrl)
49
50!!! AS: idecal is a hack to be able to read planeto starts...
51!!!     .... while keeping everything OK for LMDZ EARTH
52  IF(planet_type=="generic") THEN
53    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
54    idecal = 4
55    annee_ref  = 2000
56  ELSE
57    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
58    idecal = 5
59    annee_ref  = tab_cntrl(5)
60  END IF
61  im         = tab_cntrl(1)
62  jm         = tab_cntrl(2)
63  lllm       = tab_cntrl(3)
64  day_ref    = tab_cntrl(4)
65  rad        = tab_cntrl(idecal+1)
66  omeg       = tab_cntrl(idecal+2)
67  g          = tab_cntrl(idecal+3)
68  cpp        = tab_cntrl(idecal+4)
69  kappa      = tab_cntrl(idecal+5)
70  daysec     = tab_cntrl(idecal+6)
71  dtvr       = tab_cntrl(idecal+7)
72  etot0      = tab_cntrl(idecal+8)
73  ptot0      = tab_cntrl(idecal+9)
74  ztot0      = tab_cntrl(idecal+10)
75  stot0      = tab_cntrl(idecal+11)
76  ang0       = tab_cntrl(idecal+12)
77  pa         = tab_cntrl(idecal+13)
78  preff      = tab_cntrl(idecal+14)
79!
80  clon       = tab_cntrl(idecal+15)
81  clat       = tab_cntrl(idecal+16)
82  grossismx  = tab_cntrl(idecal+17)
83  grossismy  = tab_cntrl(idecal+18)
84!
85  IF ( tab_cntrl(idecal+19)==1. )  THEN
86    fxyhypb  = .TRUE.
87!   dzoomx   = tab_cntrl(25)
88!   dzoomy   = tab_cntrl(26)
89!   taux     = tab_cntrl(28)
90!   tauy     = tab_cntrl(29)
91  ELSE
92    fxyhypb = .FALSE.
93    ysinus  = tab_cntrl(idecal+22)==1.
94  END IF
95
96  day_ini    = tab_cntrl(30)
97  itau_dyn   = tab_cntrl(31)
98  start_time = tab_cntrl(32)
99
100!-------------------------------------------------------------------------------
101  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
102  CALL check_dim(im,iim,'im','im')
103  CALL check_dim(jm,jjm,'jm','jm')
104  CALL check_dim(lllm,llm,'lm','lllm')
105  CALL get_var1("rlonu",rlonu)
106  CALL get_var1("rlatu",rlatu)
107  CALL get_var1("rlonv",rlonv)
108  CALL get_var1("rlatv",rlatv)
109  CALL get_var2("cu"   ,cu)
110  CALL get_var2("cv"   ,cv)
111  CALL get_var2("aire" ,aire)
112  var="temps"
113  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
114    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
115    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time"
116    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
117  END IF
118  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
119  CALL get_var2("phisinit",phis)
120  CALL get_var3("ucov",ucov)
121  CALL get_var3("vcov",vcov)
122  CALL get_var3("teta",teta)
123  CALL get_var3("masse",masse)
124  CALL get_var2("ps",ps)
125
126!--- Tracers
127  DO iq=1,nqtot
128    var=tname(iq)
129    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
130      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
131    END IF
132    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
133    WRITE(lunout,*)"         It is hence initialized to zero"
134    q(:,:,:,iq)=0.
135   !--- CRisi: for isotops, theoretical initialization using very simplified
136   !           Rayleigh distillation las.
137    IF(ok_isotopes.AND.iso_num(iq)>0) THEN
138      IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq))    &
139     &             *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
140      IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq)))
141    END IF
142  END DO
143
144  CALL err(NF90_CLOSE(fID),"close",fichnom)
145  day_ini=day_ini+INT(time)
146  time=time-INT(time)
147
148
149  CONTAINS
150
151
152SUBROUTINE check_dim(n1,n2,str1,str2)
153  INTEGER,          INTENT(IN) :: n1, n2
154  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
155  CHARACTER(LEN=100) :: s1, s2
156  IF(n1/=n2) THEN
157    s1='value of '//TRIM(str1)//' ='
158    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
159    WRITE(msg,'(10x,a,i4,2x,a,i4)'),TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2
160    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
161  END IF
162END SUBROUTINE check_dim
163
164
165SUBROUTINE get_var1(var,v)
166  CHARACTER(LEN=*), INTENT(IN)  :: var
167  REAL,             INTENT(OUT) :: v(:)
168  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
169  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
170END SUBROUTINE get_var1
171
172
173SUBROUTINE get_var2(var,v)
174  CHARACTER(LEN=*), INTENT(IN)  :: var
175  REAL,             INTENT(OUT) :: v(:,:)
176  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
177  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
178END SUBROUTINE get_var2
179
180
181SUBROUTINE get_var3(var,v)
182  CHARACTER(LEN=*), INTENT(IN)  :: var
183  REAL,             INTENT(OUT) :: v(:,:,:)
184  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
185  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
186END SUBROUTINE get_var3
187
188
189SUBROUTINE err(ierr,typ,nam)
190  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
191  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
192  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
193  IF(ierr==NF90_NoERR) RETURN
194  SELECT CASE(typ)
195    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
196    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
197    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
198    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
199  END SELECT
200  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
201END SUBROUTINE err
202
203END SUBROUTINE dynetat0
Note: See TracBrowser for help on using the repository browser.