Changeset 899 for codes/icosagcm/trunk/src/initial
- Timestamp:
- 06/13/19 16:45:41 (5 years ago)
- Location:
- codes/icosagcm/trunk/src/initial
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/initial/etat0.f90
r581 r899 66 66 67 67 SUBROUTINE etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_geopot,f_w, f_q) 68 USE mpipara, ONLY : is_mpi_root69 68 USE disvert_mod 70 69 ! Generic interface … … 96 95 97 96 REAL(rstd),POINTER :: ps(:), mass(:,:) 98 LOGICAL :: autoinit_mass, autoinit_geopot,collocated99 INTEGER :: ind ,i,j,ij,l97 LOGICAL :: autoinit_mass, collocated 98 INTEGER :: ind 100 99 101 100 ! most etat0 routines set ps and not mass … … 248 247 249 248 REAL(rstd) :: p(iim*jjm,llm+1) 250 REAL(rstd) :: cppd,Rd, mass, p_ij, q_ij,r_ij,chi,nu, entropy, theta249 REAL(rstd) :: cppd,Rd, mass, p_ij, chi,nu, entropy, theta 251 250 INTEGER :: i,j,ij,l 252 251 … … 323 322 REAL(rstd) :: q_e(3*iim*jjm,llm,nqtot) 324 323 325 INTEGER :: l,i ,j,ij324 INTEGER :: l,ij 326 325 REAL :: p_ik, v_ik, mass_ik 327 326 LOGICAL :: autoinit_mass, autoinit_NH -
codes/icosagcm/trunk/src/initial/etat0_academic.f90
r548 r899 19 19 TYPE(t_field),POINTER,SAVE :: f_Ki(:) 20 20 TYPE(t_field),POINTER,SAVE :: f_temp(:) 21 22 REAL(rstd),POINTER :: Ki(:,:)23 REAL(rstd),POINTER :: temp(:)24 INTEGER :: ind25 21 26 22 CALL allocate_field(f_ps,field_t,type_real) … … 92 88 REAL(rstd) :: ddsin 93 89 REAL(rstd) :: thetarappel 94 REAL(rstd) :: l on,lat90 REAL(rstd) :: lat 95 91 REAL(rstd) :: p(iim*jjm,llm+1) 96 REAL(rstd) :: alpha(iim*jjm,llm),beta(iim*jjm,llm)97 REAL(rstd) :: delta98 REAL(rstd) :: pks(iim*jjm),pk(iim*jjm,llm)99 92 REAL(rstd) :: phi(iim*jjm,llm) 100 93 REAL(rstd) :: x -
codes/icosagcm/trunk/src/initial/etat0_dcmip1.f90
r548 r899 15 15 !$OMP THREADPRIVATE(lon0) 16 16 REAL(rstd), SAVE :: lat0=0.0 17 !$OMP THREADPRIVATE(lat0) 18 REAL(rstd), SAVE :: alpha=0.0 19 !$OMP THREADPRIVATE(alpha) 17 !$OMP THREADPRIVATE(lat0) 20 18 REAL(rstd), SAVE :: R0 21 19 !$OMP THREADPRIVATE(R0) 22 REAL(rstd), SAVE :: lat1=0.23 !$OMP THREADPRIVATE(lat1)24 REAL(rstd), SAVE :: lat2=0.25 !$OMP THREADPRIVATE(lat2)26 REAL(rstd), SAVE :: lon1=pi/627 !$OMP THREADPRIVATE(lon1)28 REAL(rstd), SAVE :: lon2=-pi/629 !$OMP THREADPRIVATE(lon2)30 20 REAL(rstd), SAVE :: latc1=0. 31 21 !$OMP THREADPRIVATE(latc1) … … 113 103 REAL(rstd) :: pr 114 104 ! REAL(rstd) :: lon, lat 115 INTEGER :: n,l105 INTEGER :: l 116 106 117 107 DO l=1, llm+1 … … 158 148 SUBROUTINE cosine_bell_1(hx) 159 149 REAL(rstd) :: hx(ngrid,llm) 160 REAL(rstd) :: rr1 ,rr2150 REAL(rstd) :: rr1 161 151 INTEGER :: n,l 162 152 DO l=ll_begin,ll_end … … 241 231 REAL(rstd)::hx(ngrid,llm) 242 232 REAL(rstd),PARAMETER:: zz1=2000.,zz2=5000.,zz0=0.5*(zz1+zz2) 243 INTEGER :: n,l233 INTEGER :: l 244 234 245 235 DO l=ll_begin,ll_end -
codes/icosagcm/trunk/src/initial/etat0_dcmip2.f90
r548 r899 60 60 REAL(rstd), INTENT(IN) :: hyam, hybm, lon, lat 61 61 REAL(rstd), INTENT(OUT) :: psj,phisj,tempj,ulonj,ulatj 62 REAL :: dummy 63 dummy =0.62 REAL :: dummy_p, dummy_z, dummy_w, dummy_rho, dummy_q 63 dummy_p=0;dummy_z=0;dummy_w=0;dummy_rho=0;dummy_q=0 64 64 SELECT CASE (testcase) 65 65 CASE(mountain) 66 CALL test2_steady_state_mountain(lon,lat,dummy ,dummy,0,.TRUE.,hyam,hybm, &67 ulonj,ulatj,dummy ,tempj,phisj,psj,dummy,dummy)66 CALL test2_steady_state_mountain(lon,lat,dummy_p,dummy_z,0,.TRUE.,hyam,hybm, & 67 ulonj,ulatj,dummy_w,tempj,phisj,psj,dummy_rho,dummy_q) 68 68 CASE(schaer_noshear) 69 CALL test2_schaer_mountain(lon,lat,dummy ,dummy,0,.TRUE.,hyam,hybm,0,&70 ulonj,ulatj,dummy ,tempj,phisj,psj,dummy,dummy)69 CALL test2_schaer_mountain(lon,lat,dummy_p,dummy_z,0,.TRUE.,hyam,hybm,0,& 70 ulonj,ulatj,dummy_w,tempj,phisj,psj,dummy_rho,dummy_q) 71 71 CASE(schaer_shear) 72 CALL test2_schaer_mountain(lon,lat,dummy ,dummy,0,.TRUE.,hyam,hybm,1, &73 ulonj,ulatj,dummy ,tempj,phisj,psj,dummy,dummy)72 CALL test2_schaer_mountain(lon,lat,dummy_p,dummy_z,0,.TRUE.,hyam,hybm,1, & 73 ulonj,ulatj,dummy_w,tempj,phisj,psj,dummy_rho,dummy_q) 74 74 END SELECT 75 75 END SUBROUTINE comp_all -
codes/icosagcm/trunk/src/initial/etat0_dcmip2016_baroclinic_wave.f90
r548 r899 2 2 USE icosa 3 3 IMPLICIT NONE 4 PRIVATE 5 6 INTEGER,SAVE :: testcase 7 !$OMP THREADPRIVATE(testcase) 4 PRIVATE 8 5 9 6 INTEGER :: perturbation … … 18 15 USE tracer_mod 19 16 IMPLICIT NONE 20 LOGICAL :: is_moist21 17 CHARACTER(LEN=255) :: str_perturbation 22 18 -
codes/icosagcm/trunk/src/initial/etat0_dcmip3.f90
r548 r899 22 22 REAL(rstd), INTENT(OUT) :: q(ngrid,llm,nqtot) 23 23 REAL(rstd),PARAMETER :: Peq=1e5 ! Reference surface pressure at the equator (hPa) 24 REAL(rstd) :: dummy, pp, zz 24 REAL(rstd) :: dummy_z, dummy_u, dummy_v, dummy_w, dummy_t, dummy_phis, dummy_ps, dummy_rho, dummy_q 25 REAL(rstd) :: pp, zz 25 26 INTEGER :: l,ij 27 dummy_z=0;dummy_u=0;dummy_v=0;dummy_w=0;dummy_t=0;dummy_phis=0;dummy_ps=0;dummy_rho=0;dummy_q=0; 26 28 pp=peq 27 29 DO ij=1,ngrid 28 CALL test3_gravity_wave(scale_factor, lon(ij),lat(ij),pp,dummy ,0, &29 dummy ,dummy,dummy,dummy,phis(ij),ps(ij),dummy,dummy)30 CALL test3_gravity_wave(scale_factor, lon(ij),lat(ij),pp,dummy_z,0, & 31 dummy_u,dummy_v,dummy_w,dummy_t,phis(ij),ps(ij),dummy_rho,dummy_q) 30 32 END DO 31 33 DO l=ll_begin,ll_endp1 … … 33 35 pp = ap(l) + bp(l)*ps(ij) ! half-layer pressure 34 36 CALL test3_gravity_wave(scale_factor, lon(ij),lat(ij),pp,zz,0, & 35 dummy ,dummy,dummy,dummy,dummy,dummy,dummy,dummy)37 dummy_u,dummy_v,dummy_w,dummy_t,dummy_phis,dummy_ps,dummy_rho,dummy_q) 36 38 geopot(ij,l) = g*zz ! initialize geopotential for NH 37 39 END DO … … 40 42 DO ij=1,ngrid 41 43 pp = .5*(ap(l)+ap(l+1)) + .5*(bp(l)+bp(l+1))*ps(ij) ! full-layer pressure 42 CALL test3_gravity_wave(scale_factor, lon(ij),lat(ij),pp,dummy ,0, &43 ulon(ij,l),ulat(ij,l),dummy ,Temp(ij,l),dummy,dummy,dummy,dummy)44 CALL test3_gravity_wave(scale_factor, lon(ij),lat(ij),pp,dummy_z,0, & 45 ulon(ij,l),ulat(ij,l),dummy_w,Temp(ij,l),dummy_phis,dummy_ps,dummy_rho,dummy_q) 44 46 END DO 45 47 q(:,l,:)=0. -
codes/icosagcm/trunk/src/initial/etat0_dcmip4.f90
r548 r899 52 52 INTEGER :: l,ij 53 53 REAL(rstd) :: etal, etavl, etas, etavs, sinlat, coslat, & 54 Y, Tave, T, phis_ave, vort, r2,utot, &54 Y, Tave, T, phis_ave, vort, utot, & 55 55 dthetaodeta_ave, dthetaodeta, dthetaodlat, duodeta, K, r 56 56 -
codes/icosagcm/trunk/src/initial/etat0_heldsz.f90
r607 r899 8 8 TYPE(t_field),POINTER :: f_theta(:) 9 9 10 REAL(rstd),ALLOCATABLE ,SAVE:: knewt_t(:),kfrict(:)10 REAL(rstd),ALLOCATABLE :: knewt_t(:),kfrict(:) 11 11 !$OMP THREADPRIVATE(knewt_t,kfrict) 12 LOGICAL , SAVE:: done=.FALSE.12 LOGICAL :: done=.FALSE. 13 13 !$OMP THREADPRIVATE(done) 14 14 15 REAL(rstd) ,SAVE:: p0,teta0,ttp,delt_y,delt_z,eps15 REAL(rstd) :: p0,teta0,ttp,delt_y,delt_z,eps 16 16 !$OMP THREADPRIVATE(p0,teta0,ttp,delt_y,delt_z,eps) 17 17 18 REAL(rstd) ,SAVE:: knewt_g, k_f,k_c_a,k_c_s18 REAL(rstd) :: knewt_g, k_f,k_c_a,k_c_s 19 19 !$OMP THREADPRIVATE(knewt_g, k_f,k_c_a,k_c_s) 20 20 … … 31 31 TYPE(t_field),POINTER :: f_q(:) 32 32 TYPE(t_field),POINTER :: f_Ki(:) 33 34 REAL(rstd),POINTER :: Ki(:,:)35 INTEGER :: ind36 33 37 34 CALL allocate_field(f_ps,field_t,type_real) … … 104 101 SUBROUTINE init_Teq 105 102 USE disvert_mod, ONLY : ap,bp 106 REAL(rstd),POINTER :: clat(:)107 103 REAL(rstd),POINTER :: theta_eq(:,:) 108 104 REAL(rstd) :: zsig … … 165 161 REAL(rstd),INTENT(OUT) :: theta_eq(iim*jjm,llm) 166 162 167 REAL(rstd) :: r,zsig, ddsin, tetastrat, tetajl163 REAL(rstd) :: zsig, ddsin, tetastrat, tetajl 168 164 INTEGER :: i,j,l,ij 169 165 … … 213 209 REAL(rstd),POINTER :: theta_eq(:,:) 214 210 REAL(rstd),POINTER :: theta(:,:) 215 REAL(rstd),POINTER :: clat(:)216 211 INTEGER::ind 217 212 -
codes/icosagcm/trunk/src/initial/etat0_venus.f90
r548 r899 102 102 REAL(rstd),POINTER :: phis(:) 103 103 REAL(rstd),POINTER :: u(:,:) 104 REAL(rstd),POINTER :: q(:,:,:) 105 REAL(rstd) :: lat(iim*jjm) ! latitude 106 REAL(rstd) :: pplay(iim*jjm, llm) ! pressure at full layers 104 REAL(rstd),POINTER :: q(:,:,:) 107 105 INTEGER :: ind 108 106 … … 143 141 144 142 real(rstd) :: lon,lat, pplay, ztemp,zdt,fact 145 logical, save :: firstcall146 143 integer :: i,j,ij, l,ll 147 144
Note: See TracChangeset
for help on using the changeset viewer.