| 1 | ! |
|---|
| 2 | ! $Id $ |
|---|
| 3 | ! |
|---|
| 4 | SUBROUTINE read_data_humidity(fichnom,iim_input,jjm_input,nlayer,timelen, nslope,q_h2o_GCM,q_co2_GCM,ps_GCM,tsurf_gcm) |
|---|
| 5 | |
|---|
| 6 | use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror, & |
|---|
| 7 | nf90_get_var, nf90_inq_varid, nf90_inq_dimid, & |
|---|
| 8 | nf90_inquire_dimension,nf90_close |
|---|
| 9 | use comsoil_h, only: nsoilmx |
|---|
| 10 | |
|---|
| 11 | IMPLICIT NONE |
|---|
| 12 | |
|---|
| 13 | !======================================================================= |
|---|
| 14 | ! |
|---|
| 15 | ! Read initial confitions file to compute the ice table |
|---|
| 16 | ! |
|---|
| 17 | !======================================================================= |
|---|
| 18 | |
|---|
| 19 | include "dimensions.h" |
|---|
| 20 | |
|---|
| 21 | !=============================================================================== |
|---|
| 22 | ! Arguments: |
|---|
| 23 | CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME |
|---|
| 24 | |
|---|
| 25 | INTEGER, INTENT(IN) :: iim_input,jjm_input,nlayer,nslope,timelen |
|---|
| 26 | |
|---|
| 27 | ! atmosphere |
|---|
| 28 | |
|---|
| 29 | REAL, INTENT(OUT) :: q_h2o_GCM(iim_input+1,jjm_input+1,timelen) |
|---|
| 30 | REAL, INTENT(OUT) :: q_co2_GCM(iim_input+1,jjm_input+1,timelen) |
|---|
| 31 | |
|---|
| 32 | REAL, INTENT(OUT) :: ps_GCM(iim_input+1,jjm_input+1,timelen) |
|---|
| 33 | |
|---|
| 34 | |
|---|
| 35 | ! Surface |
|---|
| 36 | REAL ,INTENT(OUT) :: tsurf_gcm(iim_input+1,jjm_input+1,nslope,timelen) ! Surface temperature of the concatenated file |
|---|
| 37 | |
|---|
| 38 | |
|---|
| 39 | |
|---|
| 40 | !=============================================================================== |
|---|
| 41 | ! Local Variables |
|---|
| 42 | CHARACTER(LEN=256) :: msg, var, modname |
|---|
| 43 | INTEGER,PARAMETER :: length=100 |
|---|
| 44 | INTEGER :: iq, fID, vID, idecal |
|---|
| 45 | INTEGER :: ierr |
|---|
| 46 | CHARACTER(len=12) :: start_file_type="earth" ! default start file type |
|---|
| 47 | |
|---|
| 48 | REAL,ALLOCATABLE :: time(:) ! times stored in start |
|---|
| 49 | INTEGER :: indextime ! index of selected time |
|---|
| 50 | |
|---|
| 51 | INTEGER :: edges(4),corner(4) |
|---|
| 52 | INTEGER :: i,j,t |
|---|
| 53 | real,save :: m_co2, m_noco2, A , B, mmean |
|---|
| 54 | |
|---|
| 55 | INTEGER :: islope |
|---|
| 56 | CHARACTER*2 :: num |
|---|
| 57 | |
|---|
| 58 | |
|---|
| 59 | !----------------------------------------------------------------------- |
|---|
| 60 | modname="pemetat0" |
|---|
| 61 | |
|---|
| 62 | m_co2 = 44.01E-3 ! CO2 molecular mass (kg/mol) |
|---|
| 63 | m_noco2 = 33.37E-3 ! Non condensible mol mass (kg/mol) |
|---|
| 64 | A =(1/m_co2 - 1/m_noco2) |
|---|
| 65 | B=1/m_noco2 |
|---|
| 66 | |
|---|
| 67 | ! Open initial state NetCDF file |
|---|
| 68 | var=fichnom |
|---|
| 69 | CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) |
|---|
| 70 | |
|---|
| 71 | CALL get_var3("co2_cropped" ,q_co2_GCM) |
|---|
| 72 | CALL get_var3("h2o_cropped" ,q_h2o_GCM) |
|---|
| 73 | CALL get_var3("ps" ,ps_GCM) |
|---|
| 74 | |
|---|
| 75 | |
|---|
| 76 | DO islope=1,nslope |
|---|
| 77 | write(num,fmt='(i2.2)') islope |
|---|
| 78 | call get_var3("tsurf_slope"//num,tsurf_gcm(:,:,islope,:)) |
|---|
| 79 | ENDDO |
|---|
| 80 | |
|---|
| 81 | print *, "tsurf_slope" |
|---|
| 82 | |
|---|
| 83 | |
|---|
| 84 | |
|---|
| 85 | |
|---|
| 86 | |
|---|
| 87 | CONTAINS |
|---|
| 88 | |
|---|
| 89 | SUBROUTINE check_dim(n1,n2,str1,str2) |
|---|
| 90 | INTEGER, INTENT(IN) :: n1, n2 |
|---|
| 91 | CHARACTER(LEN=*), INTENT(IN) :: str1, str2 |
|---|
| 92 | CHARACTER(LEN=256) :: s1, s2 |
|---|
| 93 | IF(n1/=n2) THEN |
|---|
| 94 | s1='value of '//TRIM(str1)//' =' |
|---|
| 95 | s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' |
|---|
| 96 | WRITE(msg,'(10x,a,i4,2x,a,i4)')TRIM(s1),n1,TRIM(s2),n2 |
|---|
| 97 | CALL ABORT_gcm(TRIM(modname),TRIM(msg),1) |
|---|
| 98 | END IF |
|---|
| 99 | END SUBROUTINE check_dim |
|---|
| 100 | |
|---|
| 101 | |
|---|
| 102 | SUBROUTINE get_var1(var,v) |
|---|
| 103 | CHARACTER(LEN=*), INTENT(IN) :: var |
|---|
| 104 | REAL, INTENT(OUT) :: v(:) |
|---|
| 105 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
|---|
| 106 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
|---|
| 107 | END SUBROUTINE get_var1 |
|---|
| 108 | |
|---|
| 109 | |
|---|
| 110 | SUBROUTINE get_var3(var,v) ! on U grid |
|---|
| 111 | CHARACTER(LEN=*), INTENT(IN) :: var |
|---|
| 112 | REAL, INTENT(OUT) :: v(:,:,:) |
|---|
| 113 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
|---|
| 114 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
|---|
| 115 | |
|---|
| 116 | END SUBROUTINE get_var3 |
|---|
| 117 | |
|---|
| 118 | SUBROUTINE get_var4(var,v) |
|---|
| 119 | CHARACTER(LEN=*), INTENT(IN) :: var |
|---|
| 120 | REAL, INTENT(OUT) :: v(:,:,:,:) |
|---|
| 121 | CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var) |
|---|
| 122 | CALL err(NF90_GET_VAR(fID,vID,v),"get",var) |
|---|
| 123 | END SUBROUTINE get_var4 |
|---|
| 124 | |
|---|
| 125 | SUBROUTINE err(ierr,typ,nam) |
|---|
| 126 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
|---|
| 127 | CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
|---|
| 128 | CHARACTER(LEN=*), INTENT(IN) :: nam !--- FIELD/FILE NAME |
|---|
| 129 | IF(ierr==NF90_NoERR) RETURN |
|---|
| 130 | SELECT CASE(typ) |
|---|
| 131 | CASE('inq'); msg="Field <"//TRIM(nam)//"> is missing" |
|---|
| 132 | CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" |
|---|
| 133 | CASE('open'); msg="File opening failed for <"//TRIM(nam)//">" |
|---|
| 134 | CASE('close'); msg="File closing failed for <"//TRIM(nam)//">" |
|---|
| 135 | END SELECT |
|---|
| 136 | CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr) |
|---|
| 137 | END SUBROUTINE err |
|---|
| 138 | |
|---|
| 139 | END SUBROUTINE read_data_humidity |
|---|