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