Changeset 170
- Timestamp:
- 09/10/13 12:04:33 (11 years ago)
- Location:
- codes/icosagcm/trunk
- Files:
-
- 4 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/etat0.f90
r168 r170 49 49 CASE ('academic') 50 50 CALL etat0_academic(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 51 CASE ('held sz')52 print*,"heldsztest case"51 CASE ('held_suarez') 52 PRINT *,"Held & Suarez (1994) test case" 53 53 CALL etat0_heldsz(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 54 54 CASE ('dcmip1') -
codes/icosagcm/trunk/src/etat0_heldsz.f90
r149 r170 1 MODULE etat0_heldsz_mod 2 USE icosa 3 IMPLICIT NONE 4 REAL(rstd),ALLOCATABLE::knewt_t(:),kfrict(:) 5 REAL(rstd)::knewt_g 6 TYPE(t_field),POINTER :: f_tetarappel(:) 7 TYPE(t_field),POINTER :: f_clat(:) 8 1 MODULE etat0_heldsz_mod 2 USE icosa 3 IMPLICIT NONE 4 PRIVATE 5 6 TYPE(t_field),POINTER :: f_theta_eq(:) 7 TYPE(t_field),POINTER :: f_theta(:) 8 TYPE(t_field),POINTER :: f_clat(:) ! FIXME, duplication 9 10 REAL(rstd),ALLOCATABLE :: knewt_t(:),kfrict(:) 11 12 LOGICAL, SAVE :: done=.FALSE. 13 14 REAL(rstd) :: teta0,ttp,delt_y,delt_z,eps 15 REAL(rstd) :: knewt_g, k_f,k_c_a,k_c_s 16 17 PUBLIC :: etat0, held_suarez 18 9 19 CONTAINS 10 20 11 21 SUBROUTINE test_etat0_heldsz 12 USE icosa13 USE kinetic_mod14 IMPLICIT NONE22 USE icosa 23 USE kinetic_mod 24 IMPLICIT NONE 15 25 TYPE(t_field),POINTER :: f_ps(:) 16 26 TYPE(t_field),POINTER :: f_phis(:) … … 19 29 TYPE(t_field),POINTER :: f_q(:) 20 30 TYPE(t_field),POINTER :: f_Ki(:) 21 31 22 32 REAL(rstd),POINTER :: Ki(:,:) 23 33 INTEGER :: ind 24 25 34 26 35 CALL allocate_field(f_ps,field_t,type_real) 27 36 CALL allocate_field(f_phis,field_t,type_real) … … 29 38 CALL allocate_field(f_u,field_u,type_real,llm) 30 39 CALL allocate_field(f_Ki,field_t,type_real,llm) 31 40 32 41 CALL etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 33 42 CALL kinetic(f_u,f_Ki) … … 36 45 CALL writefield('theta',f_theta_rhodz) 37 46 END SUBROUTINE test_etat0_heldsz 38 39 47 40 48 SUBROUTINE etat0(f_ps,f_phis,f_theta_rhodz,f_u, f_q) 41 USE icosa 42 IMPLICIT NONE 49 USE icosa 50 USE theta2theta_rhodz_mod 51 IMPLICIT NONE 43 52 TYPE(t_field),POINTER :: f_ps(:) 44 53 TYPE(t_field),POINTER :: f_phis(:) … … 46 55 TYPE(t_field),POINTER :: f_u(:) 47 56 TYPE(t_field),POINTER :: f_q(:) 48 57 49 58 REAL(rstd),POINTER :: ps(:) 50 59 REAL(rstd),POINTER :: phis(:) … … 52 61 REAL(rstd),POINTER :: u(:,:) 53 62 REAL(rstd),POINTER :: q(:,:,:) 63 REAL(rstd),POINTER :: clat(:) 64 REAL(rstd),POINTER :: theta_eq(:,:) 65 REAL(rstd),POINTER :: theta(:,:) 66 54 67 INTEGER :: ind 55 REAL(rstd),POINTER::clat(:) 56 REAL(rstd),POINTER::tetarappel(:,:) 57 58 CALL allocate_field(f_tetarappel,field_t,type_real,llm) 59 CALL allocate_field(f_clat,field_t,type_real) 60 ALLOCATE(knewt_t(llm)); ALLOCATE( kfrict(llm)) 61 68 69 CALL Init_Teq 62 70 DO ind=1,ndomain 63 CALL swap_dimensions(ind) 64 CALL swap_geometry(ind) 65 ps=f_ps(ind) 66 phis=f_phis(ind) 67 theta_rhodz=f_theta_rhodz(ind) 68 tetarappel=f_tetarappel(ind) 69 u=f_u(ind) 70 q=f_q(ind) 71 q=1e2 72 clat=f_clat(ind) 73 CALL compute_etat0_heldsz(ps, phis, theta_rhodz, u,clat,tetarappel) 71 CALL swap_dimensions(ind) 72 CALL swap_geometry(ind) 73 74 theta_eq=f_theta_eq(ind) 75 clat=f_clat(ind) 76 CALL compute_Teq(clat,theta_eq) ! FIXME : already done by Init_Teq 77 78 ps=f_ps(ind) 79 phis=f_phis(ind) 80 u=f_u(ind) 81 ps(:)=1e5 82 phis(:)=0. 83 u(:,:)=0 84 85 theta_rhodz=f_theta_rhodz(ind) 86 theta=f_theta(ind) 87 CALL compute_etat0_heldsz(theta_eq,theta) 88 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 89 q=f_q(ind) 90 q(:,:,:)=1e2 74 91 ENDDO 75 92 END SUBROUTINE etat0 76 93 77 SUBROUTINE compute_etat0_heldsz(ps, phis, theta_rhodz, u,clat,tetarappel) 78 USE icosa 79 USE disvert_mod 80 USE pression_mod 81 USE exner_mod 82 USE geopotential_mod 83 USE theta2theta_rhodz_mod 84 IMPLICIT NONE 85 REAL(rstd),INTENT(OUT) :: ps(iim*jjm) 86 REAL(rstd),INTENT(OUT) :: phis(iim*jjm) 87 REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) 88 REAL(rstd),INTENT(OUT) :: u(3*iim*jjm,llm) 89 REAL(rstd),INTENT(OUT) :: clat(iim*jjm) 90 REAL(rstd),INTENT(OUT) :: tetarappel(iim*jjm,llm) 91 92 INTEGER :: i,j,l,ij 93 REAL(rstd) :: r 94 REAL(rstd) :: theta(iim*jjm,llm) 95 REAL(rstd) :: zsig 96 INTEGER :: lsup 97 REAL(rstd) :: ddsin 98 REAL(rstd) :: lon,lat 99 REAL(rstd) :: p(iim*jjm,llm+1) 100 REAL(rstd) :: alpha(iim*jjm,llm),beta(iim*jjm,llm) 101 REAL(rstd) :: delta 102 REAL(rstd) :: pks(iim*jjm),pk(iim*jjm,llm) 103 REAL(rstd) :: phi(iim*jjm,llm) 104 REAL(rstd) :: x 105 REAL(rstd) :: fact(3*iim*jjm) 106 REAL(rstd) :: ut(3*iim*jjm,llm) 107 108 REAL(rstd) :: teta0,ttp,delt_y,delt_z,eps 109 REAL(rstd) :: k_f,k_c_a,k_c_s 110 REAL(rstd) :: zz,ran1 111 REAL(rstd) :: tetastrat,tetajl(iim*jjm,llm) 112 REAL(rstd) :: slat(iim*jjm) 113 !-------------choces of parametes and get it 114 k_f=1. !friction 115 CALL getin('k_j',k_f) 116 k_f=1./(daysec*k_f) 117 k_c_s=4. !cooling surface 118 CALL getin('k_c_s',k_c_s) 119 k_c_s=1./(daysec*k_c_s) 120 k_c_a=40. !cooling free atm 121 CALL getin('k_c_a',k_c_a) 122 k_c_a=1./(daysec*k_c_a) 123 ! Constants for Teta equilibrium profile 124 teta0=315. ! mean Teta (S.H. 315K) 125 CALL getin('teta0',teta0) 126 ttp=200. ! Tropopause temperature (S.H. 200K) 127 CALL getin('ttp',ttp) 128 eps=0. ! Deviation to N-S symmetry(~0-20K) 129 CALL getin('eps',eps) 130 delt_y=60. ! Merid Temp. Gradient (S.H. 60K) 131 CALL getin('delt_y',delt_y) 132 delt_z=10. ! Vertical Gradient (S.H. 10K) 133 CALL getin('delt_z',delt_z) 134 !----------------------------------------------------------- 135 knewt_g=k_c_a 136 DO l=1,llm 137 zsig=ap(l)/preff+bp(l) 138 knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3) 139 kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3) 140 ENDDO 141 DO j=jj_begin-1,jj_end+1 142 DO i=ii_begin-1,ii_end+1 143 ij=(j-1)*iim+i 144 CALL xyz2lonlat(xyz_i(ij,:),lon,lat) 145 clat(ij)=cos(lat) 146 slat(ij)=sin(lat) 147 ENDDO 148 ENDDO 94 SUBROUTINE init_Teq 95 USE icosa 96 USE disvert_mod, ONLY : ap,bp 97 IMPLICIT NONE 98 REAL(rstd),POINTER :: clat(:) 99 REAL(rstd),POINTER :: theta_eq(:,:) 100 REAL(rstd) :: zsig 101 INTEGER :: ind, l 102 103 IF(.NOT.done) THEN 104 done = .TRUE. 105 106 CALL allocate_field(f_theta,field_t,type_real,llm) 107 CALL allocate_field(f_theta_eq,field_t,type_real,llm) 108 CALL allocate_field(f_clat,field_t,type_real) 109 ALLOCATE(knewt_t(llm)); ALLOCATE( kfrict(llm)) 110 111 k_f=1. !friction 112 CALL getin('k_j',k_f) 113 k_f=1./(daysec*k_f) 114 k_c_s=4. !cooling surface 115 CALL getin('k_c_s',k_c_s) 116 k_c_s=1./(daysec*k_c_s) 117 k_c_a=40. !cooling free atm 118 CALL getin('k_c_a',k_c_a) 119 k_c_a=1./(daysec*k_c_a) 120 ! Constants for Teta equilibrium profile 121 teta0=315. ! mean Teta (S.H. 315K) 122 CALL getin('teta0',teta0) 123 ttp=200. ! Tropopause temperature (S.H. 200K) 124 CALL getin('ttp',ttp) 125 eps=0. ! Deviation to N-S symmetry(~0-20K) 126 CALL getin('eps',eps) 127 delt_y=60. ! Merid Temp. Gradient (S.H. 60K) 128 CALL getin('delt_y',delt_y) 129 delt_z=10. ! Vertical Gradient (S.H. 10K) 130 CALL getin('delt_z',delt_z) 131 132 !----------------------------------------------------------- 133 knewt_g=k_c_a 134 DO l=1,llm 135 zsig=ap(l)/preff+bp(l) 136 knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3) 137 kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3) 138 ENDDO 139 140 DO ind=1,ndomain 141 CALL swap_dimensions(ind) 142 CALL swap_geometry(ind) 143 clat=f_clat(ind) 144 theta_eq=f_theta_eq(ind) 145 CALL compute_Teq(clat,theta_eq) 146 ENDDO 147 148 ELSE 149 PRINT *, 'Init_Teq called twice' 150 CALL ABORT 151 END IF 152 153 END SUBROUTINE init_Teq 154 155 SUBROUTINE compute_Teq(clat,theta_eq) 156 USE icosa 157 USE disvert_mod 158 IMPLICIT NONE 159 REAL(rstd),INTENT(OUT) :: clat(iim*jjm) 160 REAL(rstd),INTENT(OUT) :: theta_eq(iim*jjm,llm) 161 162 REAL(rstd) :: lon, lat, r, zsig, ddsin, tetastrat, tetajl 163 REAL(rstd) :: slat(iim*jjm) 164 INTEGER :: i,j,l,ij 165 166 DO j=jj_begin-1,jj_end+1 167 DO i=ii_begin-1,ii_end+1 168 ij=(j-1)*iim+i 169 CALL xyz2lonlat(xyz_i(ij,:),lon,lat) 170 clat(ij)=cos(lat) 171 slat(ij)=sin(lat) 172 ENDDO 173 ENDDO 149 174 150 175 DO l=1,llm 151 176 zsig=ap(l)/preff+bp(l) 152 177 tetastrat=ttp*zsig**(-kappa) 153 154 178 DO j=jj_begin-1,jj_end+1 179 DO i=ii_begin-1,ii_end+1 155 180 ij=(j-1)*iim+i 156 181 ddsin=slat(ij) 157 tetajl(ij,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin & 158 -delt_z*(1.-ddsin*ddsin)*log(zsig) 159 tetajl(ij,l)=MAX(tetajl(ij,l),tetastrat) 160 tetarappel(ij,l)=tetajl(ij,l) 161 ENDDO 162 ENDDO 163 ENDDO 164 165 DO j=jj_begin-1,jj_end+1 166 DO i=ii_begin-1,ii_end+1 167 ij=(j-1)*iim+i 168 ps(ij)=100000.0 169 phis(ij)=0.0 170 ENDDO 171 ENDDO 172 173 174 CALL compute_pression(ps,p,1) 175 CALL compute_exner(ps,p,pks,pk,1) 176 theta(:,:)=tetarappel(:,:) 177 CALL compute_geopotential(phis,pks,pk,theta,phi,1) 178 179 u=0.0 !!wind 0 180 !============================================================ 181 DO l=1,llm 182 DO j=jj_begin-1,jj_end+1 183 DO i=ii_begin-1,ii_end+1 184 ij=(j-1)*iim+i 185 CALL RANDOM_NUMBER(r); r = 0.0 186 theta(ij,l)=theta(ij,l)*(1.+0.0005*r) 187 ENDDO 188 ENDDO 189 ENDDO 190 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 182 tetajl=teta0-delt_y*ddsin*ddsin+eps*ddsin & 183 -delt_z*(1.-ddsin*ddsin)*log(zsig) 184 theta_eq(ij,l)=MAX(tetajl,tetastrat) 185 ENDDO 186 ENDDO 187 ENDDO 188 END SUBROUTINE compute_Teq 189 190 SUBROUTINE compute_etat0_heldsz(theta_eq, theta) 191 USE icosa 192 USE disvert_mod 193 USE pression_mod 194 USE exner_mod 195 USE geopotential_mod 196 USE theta2theta_rhodz_mod 197 IMPLICIT NONE 198 REAL(rstd),INTENT(IN) :: theta_eq(iim*jjm,llm) 199 REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm) 200 201 REAL(rstd) :: r ! random number 202 INTEGER :: i,j,l,ij 203 204 DO l=1,llm 205 DO j=jj_begin-1,jj_end+1 206 DO i=ii_begin-1,ii_end+1 207 ij=(j-1)*iim+i 208 CALL RANDOM_NUMBER(r); r = 0.0 209 theta(ij,l)=theta_eq(ij,l)*(1.+0.0005*r) 210 ENDDO 211 ENDDO 212 ENDDO 191 213 192 214 END SUBROUTINE compute_etat0_heldsz 193 215 194 216 195 SUBROUTINE held_saurez(f_ps,f_theta_rhodz,f_u)196 197 217 SUBROUTINE held_suarez(f_ps,f_theta_rhodz,f_u) 218 USE icosa 219 IMPLICIT NONE 198 220 TYPE(t_field),POINTER :: f_theta_rhodz(:) 199 221 TYPE(t_field),POINTER :: f_u(:) … … 202 224 REAL(rstd),POINTER :: u(:,:) 203 225 REAL(rstd),POINTER :: ps(:) 204 REAL(rstd),POINTER :: tetarappel(:,:) 226 REAL(rstd),POINTER :: theta_eq(:,:) 227 REAL(rstd),POINTER :: theta(:,:) 205 228 REAL(rstd),POINTER :: clat(:) 206 229 INTEGER::ind 207 230 208 231 DO ind=1,ndomain 209 CALL swap_dimensions(ind) 210 CALL swap_geometry(ind) 211 theta_rhodz=f_theta_rhodz(ind) 212 u=f_u(ind) 213 ps=f_ps(ind) 214 tetarappel=f_tetarappel(ind) 215 clat=f_clat(ind) 216 CALL compute_heldsz(ps,theta_rhodz,u,clat,tetarappel) 217 ENDDO 218 END SUBROUTINE held_saurez 219 220 SUBROUTINE compute_heldsz(ps,theta_rhodz,u,clat,tetarappel) 221 USE icosa 222 USE theta2theta_rhodz_mod 223 IMPLICIT NONE 224 REAL(rstd),INTENT(IN)::ps(iim*jjm) 225 REAL(rstd),INTENT(INOUT) :: theta_rhodz(iim*jjm,llm) 226 REAL(rstd),INTENT(INOUT) :: u(3*iim*jjm,llm) 227 REAL(rstd)::theta(iim*jjm,llm) 228 REAL(rstd),INTENT(IN)::tetarappel(iim*jjm,llm) 229 REAL(rstd),INTENT(IN):: clat(iim*jjm) 230 INTEGER :: i,j,l,ij 231 232 CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1) 232 CALL swap_dimensions(ind) 233 CALL swap_geometry(ind) 234 theta_rhodz=f_theta_rhodz(ind) 235 u=f_u(ind) 236 ps=f_ps(ind) 237 theta_eq=f_theta_eq(ind) 238 theta=f_theta(ind) 239 clat=f_clat(ind) 240 CALL compute_heldsz(ps,theta_eq,clat, theta_rhodz,u, theta) 241 ENDDO 242 END SUBROUTINE held_suarez 243 244 SUBROUTINE compute_heldsz(ps,theta_eq,clat, theta_rhodz,u, theta) 245 USE icosa 246 USE theta2theta_rhodz_mod 247 IMPLICIT NONE 248 REAL(rstd),INTENT(IN) :: ps(iim*jjm) 249 REAL(rstd),INTENT(IN) :: theta_eq(iim*jjm,llm) 250 REAL(rstd),INTENT(IN) :: clat(iim*jjm) 251 REAL(rstd),INTENT(INOUT) :: theta_rhodz(iim*jjm,llm) 252 REAL(rstd),INTENT(INOUT) :: u(3*iim*jjm,llm) 253 REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm) 254 255 INTEGER :: i,j,l,ij 256 257 CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1) 233 258 DO l=1,llm 234 DO j=jj_begin-1,jj_end+1235 DO i=ii_begin-1,ii_end+1236 ij=(j-1)*iim+i237 theta(ij,l)=theta(ij,l) - dt*(theta(ij,l)-tetarappel(ij,l))* &238 (knewt_g+knewt_t(l)*clat(ij)**4 )239 240 ENDDO241 ENDDO 242 243 244 245 246 247 248 259 DO j=jj_begin-1,jj_end+1 260 DO i=ii_begin-1,ii_end+1 261 ij=(j-1)*iim+i 262 theta(ij,l)=theta(ij,l) - dt*(theta(ij,l)-theta_eq(ij,l))* & 263 (knewt_g+knewt_t(l)*clat(ij)**4 ) 264 ENDDO 265 ENDDO 266 ENDDO 267 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 268 269 Do l=1,llm 270 u(:,l)=u(:,l)*(1.-dt*kfrict(l)) 271 END DO 272 273 END SUBROUTINE compute_heldsz 249 274 250 275 END MODULE etat0_heldsz_mod -
codes/icosagcm/trunk/src/physics.f90
r149 r170 1 1 MODULE physics_mod 2 2 3 CHARACTER(LEN=255) :: physics_type=" none"3 CHARACTER(LEN=255) :: physics_type="automatic" 4 4 5 5 … … 7 7 8 8 SUBROUTINE init_physics 9 USE icosa10 USE physics_dcmip_mod,init_physics_dcmip=>init_physics11 USE physics_dry_mod12 IMPLICIT NONE13 9 USE icosa 10 USE physics_dcmip_mod,init_physics_dcmip=>init_physics 11 USE physics_dry_mod 12 IMPLICIT NONE 13 14 14 CALL getin("physics",physics_type) 15 15 16 16 SELECT CASE(TRIM(physics_type)) 17 CASE ('none') 18 19 CASE ('dcmip') 20 CALL init_physics_dcmip 17 CASE ('automatic') 21 18 22 CASE ('lmd') 23 CALL init_physics_dry 24 25 CASE DEFAULT 26 PRINT*, 'Bad selector for variable physics init <',physics_type, & 27 '> options are <none>, <dcmip>,' 19 CASE ('dcmip') 20 CALL init_physics_dcmip 28 21 22 CASE ('dry') 23 CALL init_physics_dry 24 25 CASE DEFAULT 26 PRINT*, 'init_physics : Bad selector for variable physics <',TRIM(physics_type), & 27 '> options are <automatic>, <dcmip>, <dry>' 28 STOP 29 29 END SELECT 30 30 31 31 END SUBROUTINE init_physics 32 32 33 33 SUBROUTINE physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 34 USE icosa35 USE physics_dry_mod36 USE physics_dcmip_mod, physics_dcmip=>physics37 USE etat0_mod38 USE etat0_heldsz_mod39 IMPLICIT NONE34 USE icosa 35 USE physics_dry_mod 36 USE physics_dcmip_mod, physics_dcmip=>physics 37 USE etat0_mod 38 USE etat0_heldsz_mod 39 IMPLICIT NONE 40 40 INTEGER, INTENT(IN) :: it 41 41 REAL(rstd),INTENT(IN)::jD_cur,jH_cur … … 46 46 TYPE(t_field),POINTER :: f_q(:) 47 47 LOGICAL:: firstcall,lastcall 48 48 49 49 SELECT CASE(TRIM(physics_type)) 50 CASE ('none')50 CASE ('automatic') 51 51 52 SELECT CASE(TRIM(etat0_type)) 53 CASE('heldsz') 54 ! CALL transfert_request(f_ps,req_i1) 55 ! CALL transfert_request(f_theta_rhodz,req_i1) 56 ! CALL transfert_request(f_ue,req_e1_vect) 57 ! CALL held_saurez(f_ps,f_theta_rhodz,f_ue) 58 CASE DEFAULT 59 PRINT*,"NO PHYSICAL PACAKAGE USED" 60 END SELECT 61 62 CASE ('dcmip') 63 CALL physics_dcmip(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 52 SELECT CASE(TRIM(etat0_type)) 53 CASE('held_suarez') 54 ! CALL transfert_request(f_ps,req_i1) 55 ! CALL transfert_request(f_theta_rhodz,req_i1) 56 ! CALL transfert_request(f_ue,req_e1_vect) 57 CALL held_suarez(f_ps,f_theta_rhodz,f_ue) 58 CASE DEFAULT 59 PRINT*,"NO PHYSICAL PACAKAGE USED" ! FIXME MPI 60 END SELECT 64 61 65 CASE ('dry') 66 CALL physics_dry(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 67 68 CASE DEFAULT 69 PRINT*, 'Bad selector for variable physics <',physics_type, & 70 '> options are <none>, <dcmip>,' 71 STOP 62 CASE ('dcmip') 63 CALL physics_dcmip(it, f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 64 65 CASE ('dry') 66 CALL physics_dry(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_ue, f_q) 67 68 CASE DEFAULT 69 PRINT*, 'Bad selector for variable physics <',TRIM(physics_type), & 70 '> options are <automatic>, <dcmip>, <dry>' 71 STOP 72 72 END SELECT 73 73 74 74 END SUBROUTINE physics 75 75 -
codes/icosagcm/trunk/src/timeloop_gcm.f90
r167 r170 303 303 304 304 !---------------------------------------------------- 305 ! jD_cur = jD_ref + day_ini - day_ref + it/day_step 306 ! jH_cur = jH_ref + start_time + mod(it,day_step)/float(day_step) 307 ! jD_cur = jD_cur + int(jH_cur) 308 ! jH_cur = jH_cur - int(jH_cur) 309 ! CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 310 311 ! CALL physics(it,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 305 jD_cur = jD_ref + day_ini - day_ref + it/day_step 306 jH_cur = jH_ref + start_time + mod(it,day_step)/float(day_step) 307 jD_cur = jD_cur + int(jH_cur) 308 jH_cur = jH_cur - int(jH_cur) 309 CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 312 310 ENDDO 313 311
Note: See TracChangeset
for help on using the changeset viewer.