[2293] | 1 | SUBROUTINE 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 | !------------------------------------------------------------------------------- |
---|
[3852] | 8 | USE infotrac, ONLY: nqtot, niso, tracers, iTraPha, tnat, alpha_ideal, tra |
---|
[2293] | 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 |
---|
[2600] | 13 | USE comvert_mod, ONLY: pa,preff |
---|
[2597] | 14 | USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad |
---|
[2603] | 15 | USE logic_mod, ONLY: fxyhypb, ysinus |
---|
[2598] | 16 | USE serre_mod, ONLY: clon, clat, grossismx, grossismy |
---|
[2601] | 17 | USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time |
---|
[3957] | 18 | USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0 |
---|
[3991] | 19 | USE strings_mod, ONLY: strIdx |
---|
| 20 | USE readTracFiles_mod, ONLY: known_phases, old_phases, nphases, phases_sep |
---|
[2600] | 21 | |
---|
[2293] | 22 | IMPLICIT NONE |
---|
| 23 | include "dimensions.h" |
---|
| 24 | include "paramet.h" |
---|
| 25 | include "comgeom2.h" |
---|
| 26 | include "description.h" |
---|
| 27 | include "iniprint.h" |
---|
| 28 | !=============================================================================== |
---|
| 29 | ! Arguments: |
---|
| 30 | CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME |
---|
| 31 | REAL, INTENT(OUT) :: vcov(iip1,jjm, llm) !--- V COVARIANT WIND |
---|
| 32 | REAL, INTENT(OUT) :: ucov(iip1,jjp1,llm) !--- U COVARIANT WIND |
---|
| 33 | REAL, INTENT(OUT) :: teta(iip1,jjp1,llm) !--- POTENTIAL TEMP. |
---|
| 34 | REAL, INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) !--- TRACERS |
---|
| 35 | REAL, INTENT(OUT) :: masse(iip1,jjp1,llm) !--- MASS PER CELL |
---|
| 36 | REAL, INTENT(OUT) :: ps(iip1,jjp1) !--- GROUND PRESSURE |
---|
| 37 | REAL, INTENT(OUT) :: phis(iip1,jjp1) !--- GEOPOTENTIAL |
---|
| 38 | !=============================================================================== |
---|
| 39 | ! Local variables: |
---|
[3957] | 40 | CHARACTER(LEN=256) :: sdum, var, modname, oldH2O |
---|
[2293] | 41 | INTEGER, PARAMETER :: length=100 |
---|
[3957] | 42 | INTEGER :: iq, fID, vID, idecal, ix, ip |
---|
[2293] | 43 | REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE |
---|
[3957] | 44 | TYPE(tra), POINTER :: tr |
---|
[2293] | 45 | !------------------------------------------------------------------------------- |
---|
| 46 | modname="dynetat0" |
---|
| 47 | |
---|
| 48 | !--- Initial state file opening |
---|
| 49 | var=fichnom |
---|
| 50 | CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) |
---|
| 51 | CALL get_var1("controle",tab_cntrl) |
---|
| 52 | |
---|
| 53 | !!! AS: idecal is a hack to be able to read planeto starts... |
---|
| 54 | !!! .... while keeping everything OK for LMDZ EARTH |
---|
| 55 | IF(planet_type=="generic") THEN |
---|
| 56 | WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files' |
---|
| 57 | idecal = 4 |
---|
| 58 | annee_ref = 2000 |
---|
| 59 | ELSE |
---|
| 60 | WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files' |
---|
| 61 | idecal = 5 |
---|
| 62 | annee_ref = tab_cntrl(5) |
---|
| 63 | END IF |
---|
| 64 | im = tab_cntrl(1) |
---|
| 65 | jm = tab_cntrl(2) |
---|
| 66 | lllm = tab_cntrl(3) |
---|
| 67 | day_ref = tab_cntrl(4) |
---|
| 68 | rad = tab_cntrl(idecal+1) |
---|
| 69 | omeg = tab_cntrl(idecal+2) |
---|
| 70 | g = tab_cntrl(idecal+3) |
---|
| 71 | cpp = tab_cntrl(idecal+4) |
---|
| 72 | kappa = tab_cntrl(idecal+5) |
---|
| 73 | daysec = tab_cntrl(idecal+6) |
---|
| 74 | dtvr = tab_cntrl(idecal+7) |
---|
| 75 | etot0 = tab_cntrl(idecal+8) |
---|
| 76 | ptot0 = tab_cntrl(idecal+9) |
---|
| 77 | ztot0 = tab_cntrl(idecal+10) |
---|
| 78 | stot0 = tab_cntrl(idecal+11) |
---|
| 79 | ang0 = tab_cntrl(idecal+12) |
---|
| 80 | pa = tab_cntrl(idecal+13) |
---|
| 81 | preff = tab_cntrl(idecal+14) |
---|
| 82 | ! |
---|
| 83 | clon = tab_cntrl(idecal+15) |
---|
| 84 | clat = tab_cntrl(idecal+16) |
---|
| 85 | grossismx = tab_cntrl(idecal+17) |
---|
| 86 | grossismy = tab_cntrl(idecal+18) |
---|
| 87 | ! |
---|
| 88 | IF ( tab_cntrl(idecal+19)==1. ) THEN |
---|
| 89 | fxyhypb = .TRUE. |
---|
| 90 | ! dzoomx = tab_cntrl(25) |
---|
| 91 | ! dzoomy = tab_cntrl(26) |
---|
| 92 | ! taux = tab_cntrl(28) |
---|
| 93 | ! tauy = tab_cntrl(29) |
---|
| 94 | ELSE |
---|
| 95 | fxyhypb = .FALSE. |
---|
| 96 | ysinus = tab_cntrl(idecal+22)==1. |
---|
| 97 | END IF |
---|
| 98 | |
---|
| 99 | day_ini = tab_cntrl(30) |
---|
| 100 | itau_dyn = tab_cntrl(31) |
---|
| 101 | start_time = tab_cntrl(32) |
---|
| 102 | |
---|
| 103 | !------------------------------------------------------------------------------- |
---|
| 104 | WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa |
---|
| 105 | CALL check_dim(im,iim,'im','im') |
---|
| 106 | CALL check_dim(jm,jjm,'jm','jm') |
---|
| 107 | CALL check_dim(lllm,llm,'lm','lllm') |
---|
[3957] | 108 | CALL get_var1("rlonu", rlonu) |
---|
| 109 | CALL get_var1("rlatu", rlatu) |
---|
| 110 | CALL get_var1("rlonv", rlonv) |
---|
| 111 | CALL get_var1("rlatv", rlatv) |
---|
| 112 | CALL get_var2("cu", cu) |
---|
| 113 | CALL get_var2("cv", cv) |
---|
| 114 | CALL get_var2("aire", aire) |
---|
[2293] | 115 | var="temps" |
---|
| 116 | IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN |
---|
| 117 | WRITE(lunout,*)TRIM(modname)//": missing field <temps>" |
---|
| 118 | WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time" |
---|
| 119 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
| 120 | END IF |
---|
| 121 | CALL err(NF90_GET_VAR(fID,vID,time),"get",var) |
---|
[3991] | 122 | CALL get_var3("vcov", vcov) |
---|
[3957] | 123 | CALL get_var3("ucov", ucov) |
---|
| 124 | CALL get_var3("teta", teta) |
---|
| 125 | CALL get_var3("masse", masse) |
---|
[3991] | 126 | CALL get_var2("phisinit", phis) |
---|
[3957] | 127 | CALL get_var2("ps", ps) |
---|
[2293] | 128 | |
---|
| 129 | !--- Tracers |
---|
| 130 | DO iq=1,nqtot |
---|
[3852] | 131 | tr => tracers(iq) |
---|
| 132 | var = tr%name |
---|
[3957] | 133 | ix = strIdx([('H2O'//phases_sep//known_phases(ip:ip), ip=1, nphases)], var) |
---|
[3991] | 134 | oldH2O = '***'; IF(ix/=0) oldH2O = 'H2O'//old_phases(ix:ix) |
---|
| 135 | !------------------------------------------------------------------------------------------------------------------ |
---|
| 136 | IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN !=== REGULAR CASE |
---|
[3957] | 137 | CALL get_var3(var, q(:,:,:,iq)) |
---|
[3991] | 138 | !------------------------------------------------------------------------------------------------------------------ |
---|
[3852] | 139 | #ifdef INCA |
---|
[3991] | 140 | ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN !=== INCA: OX INSTEAD OF O3 |
---|
[3957] | 141 | WRITE(lunout,*)TRIM(modname)//': Tracer <O3> is missing => initialized to OX' |
---|
| 142 | CALL get_var3('OX', q(:,:,:,iq)) |
---|
[3852] | 143 | #endif |
---|
[3991] | 144 | !------------------------------------------------------------------------------------------------------------------ |
---|
| 145 | ELSE IF(NF90_INQ_VARID(fID, oldH2O, vID) == NF90_NoErr .AND. ix /= 0 ) THEN !=== OLD WATER PHASES |
---|
| 146 | WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to '//TRIM(oldH2O) |
---|
| 147 | CALL get_var3(oldH2O, q(:,:,:,iq)) |
---|
| 148 | !------------------------------------------------------------------------------------------------------------------ |
---|
| 149 | ELSE IF(niso > 0 .AND. tr%iso_num > 0) THEN !=== ISOTOPES, CRisi |
---|
| 150 | IF(tr%iso_zon == 0) THEN |
---|
| 151 | WRITE(lunout,*)TRIM(modname)//': Isotope <'//TRIM(var)//'> is missing => initialized with a' & |
---|
| 152 | //' simplified Rayleigh distillation law' |
---|
| 153 | q(:,:,:,iq) = q(:,:,:,tr%iprnt) * tnat(tr%iso_num) & |
---|
| 154 | *(q(:,:,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1) |
---|
| 155 | ELSE |
---|
| 156 | WRITE(lunout,*)TRIM(modname)//': Isotope geographical tracer <'//TRIM(var)//'> is missing ' & |
---|
| 157 | //'=> initialized its parent isotope concentration' |
---|
| 158 | q(:,:,:,iq) = q(:,:,:,iTraPha(tr%iso_num,tr%iso_pha)) |
---|
[3852] | 159 | END IF |
---|
[3991] | 160 | !------------------------------------------------------------------------------------------------------------------ |
---|
| 161 | ELSE !=== MISSING: SET TO 0 |
---|
[3957] | 162 | WRITE(lunout,*)TRIM(modname)//': Tracer <'//TRIM(var)//'> is missing => initialized to zero' |
---|
| 163 | q(:,:,:,iq)=0. |
---|
[2293] | 164 | END IF |
---|
[3991] | 165 | !------------------------------------------------------------------------------------------------------------------ |
---|
[2293] | 166 | END DO |
---|
| 167 | CALL err(NF90_CLOSE(fID),"close",fichnom) |
---|
| 168 | day_ini=day_ini+INT(time) |
---|
| 169 | time=time-INT(time) |
---|
| 170 | |
---|
| 171 | |
---|
| 172 | CONTAINS |
---|
| 173 | |
---|
| 174 | |
---|
| 175 | SUBROUTINE check_dim(n1,n2,str1,str2) |
---|
| 176 | INTEGER, INTENT(IN) :: n1, n2 |
---|
| 177 | CHARACTER(LEN=*), INTENT(IN) :: str1, str2 |
---|
[3852] | 178 | CHARACTER(LEN=256) :: s1, s2 |
---|
[2293] | 179 | IF(n1/=n2) THEN |
---|
| 180 | s1='value of '//TRIM(str1)//' =' |
---|
| 181 | s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' |
---|
[3957] | 182 | WRITE(sdum,'(10x,a,i4,2x,a,i4)'),TRIM(s1),n1,TRIM(s2),n2 |
---|
[3852] | 183 | CALL ABORT_gcm(TRIM(modname),TRIM(sdum),1) |
---|
[2293] | 184 | END IF |
---|
| 185 | END SUBROUTINE check_dim |
---|
| 186 | |
---|
| 187 | |
---|
[3957] | 188 | SUBROUTINE get_var1(var, v) |
---|
[2293] | 189 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 190 | REAL, INTENT(OUT) :: v(:) |
---|
| 191 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
| 192 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
---|
| 193 | END SUBROUTINE get_var1 |
---|
| 194 | |
---|
| 195 | |
---|
[3957] | 196 | SUBROUTINE get_var2(var, v) |
---|
[2293] | 197 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 198 | REAL, INTENT(OUT) :: v(:,:) |
---|
| 199 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
| 200 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
---|
| 201 | END SUBROUTINE get_var2 |
---|
| 202 | |
---|
| 203 | |
---|
[3957] | 204 | SUBROUTINE get_var3(var, v) |
---|
[2293] | 205 | CHARACTER(LEN=*), INTENT(IN) :: var |
---|
| 206 | REAL, INTENT(OUT) :: v(:,:,:) |
---|
| 207 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
---|
| 208 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
---|
| 209 | END SUBROUTINE get_var3 |
---|
| 210 | |
---|
| 211 | |
---|
[3957] | 212 | SUBROUTINE err(ierr, typ, nam) |
---|
[2293] | 213 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
---|
| 214 | CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
---|
| 215 | CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME |
---|
| 216 | IF(ierr==NF90_NoERR) RETURN |
---|
| 217 | SELECT CASE(typ) |
---|
[3852] | 218 | CASE('inq'); sdum="Field <"//TRIM(nam)//"> is missing" |
---|
| 219 | CASE('get'); sdum="Reading failed for <"//TRIM(nam)//">" |
---|
| 220 | CASE('open'); sdum="File opening failed for <"//TRIM(nam)//">" |
---|
| 221 | CASE('close'); sdum="File closing failed for <"//TRIM(nam)//">" |
---|
[2293] | 222 | END SELECT |
---|
[3852] | 223 | CALL ABORT_gcm(TRIM(modname),TRIM(sdum),ierr) |
---|
[2293] | 224 | END SUBROUTINE err |
---|
| 225 | |
---|
| 226 | END SUBROUTINE dynetat0 |
---|