[1992] | 1 | |
---|
[1403] | 2 | ! $Id: iniphysiq.F90 2274 2015-05-13 11:39:20Z fairhead $ |
---|
[1671] | 3 | |
---|
| 4 | |
---|
[2258] | 5 | SUBROUTINE iniphysiq(iim,jjm,nlayer,punjours, pdayref,ptimestep, & |
---|
| 6 | rlatu,rlonv,aire,cu,cv, & |
---|
| 7 | prad,pg,pr,pcpp,iflag_phys) |
---|
| 8 | USE dimphy, ONLY: klev ! number of atmospheric levels |
---|
| 9 | USE mod_grid_phy_lmdz, ONLY: klon_glo ! number of atmospheric columns |
---|
| 10 | ! (on full grid) |
---|
| 11 | USE mod_phys_lmdz_para, ONLY: klon_omp, & ! number of columns (on local omp grid) |
---|
| 12 | klon_omp_begin, & ! start index of local omp subgrid |
---|
| 13 | klon_omp_end, & ! end index of local omp subgrid |
---|
| 14 | klon_mpi_begin ! start indes of columns (on local mpi grid) |
---|
| 15 | USE comgeomphy, ONLY: initcomgeomphy, & |
---|
| 16 | airephy, & ! physics grid area (m2) |
---|
| 17 | cuphy, & ! cu coeff. (u_covariant = cu * u) |
---|
| 18 | cvphy, & ! cv coeff. (v_covariant = cv * v) |
---|
| 19 | rlond, & ! longitudes |
---|
| 20 | rlatd ! latitudes |
---|
[1992] | 21 | USE phyaqua_mod, ONLY: iniaqua |
---|
| 22 | IMPLICIT NONE |
---|
[1671] | 23 | |
---|
[1992] | 24 | ! ======================================================================= |
---|
| 25 | ! Initialisation of the physical constants and some positional and |
---|
| 26 | ! geometrical arrays for the physics |
---|
| 27 | ! ======================================================================= |
---|
[1403] | 28 | |
---|
[1992] | 29 | include "YOMCST.h" |
---|
| 30 | include "iniprint.h" |
---|
| 31 | |
---|
| 32 | REAL, INTENT (IN) :: prad ! radius of the planet (m) |
---|
| 33 | REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2) |
---|
| 34 | REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu |
---|
| 35 | REAL, INTENT (IN) :: pcpp ! specific heat Cp |
---|
| 36 | REAL, INTENT (IN) :: punjours ! length (in s) of a standard day |
---|
| 37 | INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers |
---|
[2258] | 38 | INTEGER, INTENT (IN) :: iim ! number of atmospheric columns along longitudes |
---|
| 39 | INTEGER, INTENT (IN) :: jjm ! number of atompsheric columns along latitudes |
---|
| 40 | REAL, INTENT (IN) :: rlatu(jjm+1) ! latitudes of the physics grid |
---|
| 41 | REAL, INTENT (IN) :: rlonv(iim+1) ! longitudes of the physics grid |
---|
| 42 | REAL, INTENT (IN) :: aire(iim+1,jjm+1) ! area of the dynamics grid (m2) |
---|
| 43 | REAL, INTENT (IN) :: cu((iim+1)*(jjm+1)) ! cu coeff. (u_covariant = cu * u) |
---|
| 44 | REAL, INTENT (IN) :: cv((iim+1)*jjm) ! cv coeff. (v_covariant = cv * v) |
---|
[1992] | 45 | INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation |
---|
| 46 | REAL, INTENT (IN) :: ptimestep !physics time step (s) |
---|
| 47 | INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called |
---|
| 48 | |
---|
| 49 | INTEGER :: ibegin, iend, offset |
---|
[2258] | 50 | INTEGER :: i,j |
---|
[1992] | 51 | CHARACTER (LEN=20) :: modname = 'iniphysiq' |
---|
| 52 | CHARACTER (LEN=80) :: abort_message |
---|
[2258] | 53 | REAL :: total_area_phy, total_area_dyn |
---|
[1992] | 54 | |
---|
[2258] | 55 | |
---|
| 56 | ! global array, on full physics grid: |
---|
| 57 | REAL,ALLOCATABLE :: latfi(:) |
---|
| 58 | REAL,ALLOCATABLE :: lonfi(:) |
---|
| 59 | REAL,ALLOCATABLE :: cufi(:) |
---|
| 60 | REAL,ALLOCATABLE :: cvfi(:) |
---|
| 61 | REAL,ALLOCATABLE :: airefi(:) |
---|
| 62 | |
---|
[1992] | 63 | IF (nlayer/=klev) THEN |
---|
| 64 | WRITE (lunout, *) 'STOP in ', trim(modname) |
---|
| 65 | WRITE (lunout, *) 'Problem with dimensions :' |
---|
| 66 | WRITE (lunout, *) 'nlayer = ', nlayer |
---|
| 67 | WRITE (lunout, *) 'klev = ', klev |
---|
| 68 | abort_message = '' |
---|
| 69 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 70 | END IF |
---|
| 71 | |
---|
[2258] | 72 | !call init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/)) |
---|
| 73 | |
---|
| 74 | ! Generate global arrays on full physics grid |
---|
| 75 | ALLOCATE(latfi(klon_glo),lonfi(klon_glo),cufi(klon_glo),cvfi(klon_glo)) |
---|
| 76 | ALLOCATE(airefi(klon_glo)) |
---|
[1992] | 77 | |
---|
[2258] | 78 | IF (klon_glo>1) THEN ! general case |
---|
| 79 | ! North pole |
---|
| 80 | latfi(1)=rlatu(1) |
---|
| 81 | lonfi(1)=0. |
---|
| 82 | cufi(1) = cu(1) |
---|
| 83 | cvfi(1) = cv(1) |
---|
| 84 | DO j=2,jjm |
---|
| 85 | DO i=1,iim |
---|
| 86 | latfi((j-2)*iim+1+i)= rlatu(j) |
---|
| 87 | lonfi((j-2)*iim+1+i)= rlonv(i) |
---|
[2274] | 88 | cufi((j-2)*iim+1+i) = cu((j-1)*(iim+1)+i) |
---|
| 89 | cvfi((j-2)*iim+1+i) = cv((j-1)*(iim+1)+i) |
---|
[2258] | 90 | ENDDO |
---|
| 91 | ENDDO |
---|
| 92 | ! South pole |
---|
| 93 | latfi(klon_glo)= rlatu(jjm+1) |
---|
| 94 | lonfi(klon_glo)= 0. |
---|
| 95 | cufi(klon_glo) = cu((iim+1)*jjm+1) |
---|
| 96 | cvfi(klon_glo) = cv((iim+1)*jjm-iim) |
---|
[1992] | 97 | |
---|
[2258] | 98 | ! build airefi(), mesh area on physics grid |
---|
| 99 | CALL gr_dyn_fi(1,iim+1,jjm+1,klon_glo,aire,airefi) |
---|
| 100 | ! Poles are single points on physics grid |
---|
| 101 | airefi(1)=sum(aire(1:iim,1)) |
---|
| 102 | airefi(klon_glo)=sum(aire(1:iim,jjm+1)) |
---|
| 103 | |
---|
| 104 | ! Sanity check: do total planet area match between physics and dynamics? |
---|
| 105 | total_area_dyn=sum(aire(1:iim,1:jjm+1)) |
---|
| 106 | total_area_phy=sum(airefi(1:klon_glo)) |
---|
| 107 | IF (total_area_dyn/=total_area_phy) THEN |
---|
| 108 | WRITE (lunout, *) 'iniphysiq: planet total surface discrepancy !!!' |
---|
| 109 | WRITE (lunout, *) ' in the dynamics total_area_dyn=', total_area_dyn |
---|
| 110 | WRITE (lunout, *) ' but in the physics total_area_phy=', total_area_phy |
---|
| 111 | IF (abs(total_area_dyn-total_area_phy)>0.00001*total_area_dyn) THEN |
---|
| 112 | ! stop here if the relative difference is more than 0.001% |
---|
| 113 | abort_message = 'planet total surface discrepancy' |
---|
| 114 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 115 | ENDIF |
---|
| 116 | ENDIF |
---|
| 117 | ELSE ! klon_glo==1, running the 1D model |
---|
| 118 | ! just copy over input values |
---|
| 119 | latfi(1)=rlatu(1) |
---|
| 120 | lonfi(1)=rlonv(1) |
---|
| 121 | cufi(1)=cu(1) |
---|
| 122 | cvfi(1)=cv(1) |
---|
| 123 | airefi(1)=aire(1,1) |
---|
| 124 | ENDIF ! of IF (klon_glo>1) |
---|
| 125 | |
---|
| 126 | !$OMP PARALLEL |
---|
| 127 | ! Now generate local lon/lat/cu/cv/area arrays |
---|
| 128 | CALL initcomgeomphy |
---|
| 129 | |
---|
[1992] | 130 | offset = klon_mpi_begin - 1 |
---|
[2258] | 131 | airephy(1:klon_omp) = airefi(offset+klon_omp_begin:offset+klon_omp_end) |
---|
| 132 | cuphy(1:klon_omp) = cufi(offset+klon_omp_begin:offset+klon_omp_end) |
---|
| 133 | cvphy(1:klon_omp) = cvfi(offset+klon_omp_begin:offset+klon_omp_end) |
---|
| 134 | rlond(1:klon_omp) = lonfi(offset+klon_omp_begin:offset+klon_omp_end) |
---|
| 135 | rlatd(1:klon_omp) = latfi(offset+klon_omp_begin:offset+klon_omp_end) |
---|
[1992] | 136 | |
---|
| 137 | ! suphel => initialize some physical constants (orbital parameters, |
---|
| 138 | ! geoid, gravity, thermodynamical constants, etc.) in the |
---|
| 139 | ! physics |
---|
| 140 | CALL suphel |
---|
| 141 | |
---|
[2258] | 142 | !$OMP END PARALLEL |
---|
[1992] | 143 | |
---|
[2258] | 144 | ! check that physical constants set in 'suphel' are coherent |
---|
| 145 | ! with values set in the dynamics: |
---|
[1992] | 146 | IF (rday/=punjours) THEN |
---|
| 147 | WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!' |
---|
| 148 | WRITE (lunout, *) ' in the dynamics punjours=', punjours |
---|
| 149 | WRITE (lunout, *) ' but in the physics RDAY=', rday |
---|
| 150 | IF (abs(rday-punjours)>0.01) THEN |
---|
| 151 | ! stop here if the relative difference is more than 1% |
---|
| 152 | abort_message = 'length of day discrepancy' |
---|
| 153 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 154 | END IF |
---|
| 155 | END IF |
---|
| 156 | IF (rg/=pg) THEN |
---|
| 157 | WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!' |
---|
| 158 | WRITE (lunout, *) ' in the dynamics pg=', pg |
---|
| 159 | WRITE (lunout, *) ' but in the physics RG=', rg |
---|
| 160 | IF (abs(rg-pg)>0.01) THEN |
---|
| 161 | ! stop here if the relative difference is more than 1% |
---|
| 162 | abort_message = 'gravity discrepancy' |
---|
| 163 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 164 | END IF |
---|
| 165 | END IF |
---|
| 166 | IF (ra/=prad) THEN |
---|
| 167 | WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!' |
---|
| 168 | WRITE (lunout, *) ' in the dynamics prad=', prad |
---|
| 169 | WRITE (lunout, *) ' but in the physics RA=', ra |
---|
| 170 | IF (abs(ra-prad)>0.01) THEN |
---|
| 171 | ! stop here if the relative difference is more than 1% |
---|
| 172 | abort_message = 'planet radius discrepancy' |
---|
| 173 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 174 | END IF |
---|
| 175 | END IF |
---|
| 176 | IF (rd/=pr) THEN |
---|
| 177 | WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!' |
---|
| 178 | WRITE (lunout, *) ' in the dynamics pr=', pr |
---|
| 179 | WRITE (lunout, *) ' but in the physics RD=', rd |
---|
| 180 | IF (abs(rd-pr)>0.01) THEN |
---|
| 181 | ! stop here if the relative difference is more than 1% |
---|
| 182 | abort_message = 'reduced gas constant discrepancy' |
---|
| 183 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 184 | END IF |
---|
| 185 | END IF |
---|
| 186 | IF (rcpd/=pcpp) THEN |
---|
| 187 | WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!' |
---|
| 188 | WRITE (lunout, *) ' in the dynamics pcpp=', pcpp |
---|
| 189 | WRITE (lunout, *) ' but in the physics RCPD=', rcpd |
---|
| 190 | IF (abs(rcpd-pcpp)>0.01) THEN |
---|
| 191 | ! stop here if the relative difference is more than 1% |
---|
| 192 | abort_message = 'specific heat discrepancy' |
---|
| 193 | CALL abort_gcm(modname, abort_message, 1) |
---|
| 194 | END IF |
---|
| 195 | END IF |
---|
| 196 | |
---|
| 197 | ! Additional initializations for aquaplanets |
---|
[2258] | 198 | !$OMP PARALLEL |
---|
[1992] | 199 | IF (iflag_phys>=100) THEN |
---|
| 200 | CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys) |
---|
| 201 | END IF |
---|
[2258] | 202 | !$OMP END PARALLEL |
---|
[1992] | 203 | |
---|
| 204 | END SUBROUTINE iniphysiq |
---|