Changeset 899
- Timestamp:
- 06/13/19 16:45:41 (5 years ago)
- Location:
- codes/icosagcm/trunk
- Files:
-
- 54 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/base/earth_const.f90
r669 r899 36 36 USE getin_mod 37 37 IMPLICIT NONE 38 REAL(rstd) :: X=139 38 40 39 CALL getin("radius",radius) -
codes/icosagcm/trunk/src/base/profiling.f90
r667 r899 41 41 SUBROUTINE enter_profile(id) 42 42 INTEGER, INTENT(IN) :: id 43 REAL :: my_chrono44 43 !$OMP MASTER 45 44 depth = depth+1 -
codes/icosagcm/trunk/src/dcmip/dcmip2016_baroclinic_wave.f90
r548 r899 40 40 ! 41 41 !======================================================================= 42 43 42 IMPLICIT NONE 44 43 45 44 !======================================================================= 46 45 ! Physical constants … … 99 98 SUBROUTINE baroclinic_wave_test(deep,moist,pertt,X,lon,lat,p,z,zcoords,u,v,t,thetav,phis,ps,rho,q) & 100 99 BIND(c, name = "baroclinic_wave_test") 101 100 use iso_c_binding 102 101 IMPLICIT NONE 103 102 … … 105 104 ! input/output params parameters at given location 106 105 !----------------------------------------------------------------------- 107 INTEGER , INTENT(IN) :: &106 INTEGER(KIND=C_INT32_T), INTENT(IN) :: & 108 107 deep, & ! Deep (1) or Shallow (0) test case 109 108 moist, & ! Moist (1) or Dry (0) test case 110 109 pertt ! Perturbation type 111 110 112 REAL( 8), INTENT(IN) :: &111 REAL(KIND=C_DOUBLE), INTENT(IN) :: & 113 112 lon, & ! Longitude (radians) 114 113 lat, & ! Latitude (radians) 115 114 X ! Earth scaling parameter 116 115 117 REAL( 8), INTENT(INOUT) :: &116 REAL(KIND=C_DOUBLE), INTENT(INOUT) :: & 118 117 p, & ! Pressure (Pa) 119 118 z ! Altitude (m) 120 119 121 INTEGER , INTENT(IN) :: zcoords ! 1 if z coordinates are specified120 INTEGER(KIND=C_INT32_T), INTENT(IN) :: zcoords ! 1 if z coordinates are specified 122 121 ! 0 if p coordinates are specified 123 122 124 REAL( 8), INTENT(OUT) :: &123 REAL(KIND=C_DOUBLE), INTENT(OUT) :: & 125 124 u, & ! Zonal wind (m s^-1) 126 125 v, & ! Meridional wind (m s^-1) … … 138 137 REAL(8) :: T0, constH, constC, scaledZ, inttau2, rratio 139 138 REAL(8) :: inttermU, bigU, rcoslat, omegarcoslat 140 REAL(8) :: eta , qratio, qnum, qden139 REAL(8) :: eta 141 140 142 141 !------------------------------------------------ -
codes/icosagcm/trunk/src/dcmip/dcmip2016_cyclone.f90
r548 r899 95 95 SUBROUTINE tropical_cyclone_test(lon,lat,p,z,zcoords,u,v,t,thetav,phis,ps,rho,q) & 96 96 BIND(c, name = "tropical_cyclone_test") 97 97 use iso_c_binding 98 98 IMPLICIT NONE 99 99 … … 102 102 !------------------------------------------------ 103 103 104 REAL( 8), INTENT(IN) :: &104 REAL(KIND=C_DOUBLE), INTENT(IN) :: & 105 105 lon, & ! Longitude (radians) 106 106 lat ! Latitude (radians) 107 107 108 REAL( 8), INTENT(INOUT) :: &108 REAL(KIND=C_DOUBLE), INTENT(INOUT) :: & 109 109 p, & ! Pressure (Pa) 110 110 z ! Height (m) 111 111 112 INTEGER , INTENT(IN) :: zcoords ! 1 if z coordinates are specified112 INTEGER(KIND=C_INT32_T), INTENT(IN) :: zcoords ! 1 if z coordinates are specified 113 113 ! 0 if p coordinates are specified 114 114 115 REAL( 8), INTENT(OUT) :: &115 REAL(KIND=C_DOUBLE), INTENT(OUT) :: & 116 116 u, & ! Zonal wind (m s^-1) 117 117 v, & ! Meridional wind (m s^-1) -
codes/icosagcm/trunk/src/dcmip/dcmip2016_supercell.f90
r548 r899 148 148 149 149 ! Variables for calculation of equatorial profile 150 REAL(8) :: exnereqs, p, T, qvs, qv 151 152 ! Error metric 153 REAL(8) :: err 150 REAL(8) :: exnereqs, p, T, qvs 154 151 155 152 ! Loop indices … … 349 346 SUBROUTINE supercell_test(lon,lat,p,z,zcoords,u,v,t,thetav,ps,rho,q,pert) & 350 347 BIND(c, name = "supercell_test") 351 348 use iso_c_binding 352 349 IMPLICIT NONE 353 350 … … 355 352 ! Input / output parameters 356 353 !------------------------------------------------ 357 REAL( 8), INTENT(IN) :: &354 REAL(KIND=c_double), INTENT(IN) :: & 358 355 lon, & ! Longitude (radians) 359 356 lat ! Latitude (radians) 360 357 361 REAL( 8), INTENT(INOUT) :: &358 REAL(KIND=c_double), INTENT(INOUT) :: & 362 359 p, & ! Pressure (Pa) 363 360 z ! Altitude (m) 364 361 365 INTEGER , INTENT(IN) :: zcoords ! 1 if z coordinates are specified362 INTEGER(KIND=c_int32_t), INTENT(IN) :: zcoords ! 1 if z coordinates are specified 366 363 ! 0 if p coordinates are specified 367 364 368 REAL( 8), INTENT(OUT) :: &365 REAL(KIND=c_double), INTENT(OUT) :: & 369 366 u, & ! Zonal wind (m s^-1) 370 367 v, & ! Meridional wind (m s^-1) … … 375 372 q ! water vapor mixing ratio (kg/kg) 376 373 377 INTEGER , INTENT(IN) :: pert ! 1 if perturbation should be included374 INTEGER(KIND=c_int32_t), INTENT(IN) :: pert ! 1 if perturbation should be included 378 375 ! 0 if no perturbation should be included 379 376 -
codes/icosagcm/trunk/src/dcmip/dcmip_initial_conditions_test_1_2_3_v5.f90
r548 r899 140 140 real(rstd) :: ptop ! Model top in p 141 141 real(rstd) :: sin_tmp, cos_tmp, sin_tmp2, cos_tmp2 ! Calculate great circle distances 142 real(rstd) :: d1, d2, r, r2 , d3, d4! For tracer calculations142 real(rstd) :: d1, d2, r, r2 ! For tracer calculations 143 143 real(rstd) :: s, bs ! Shape function, and parameter 144 144 real(rstd) :: lonp ! Translational longitude, depends on time -
codes/icosagcm/trunk/src/dcmip/guided_ncar_mod.f90
r548 r899 38 38 REAL(rstd), INTENT(IN):: tt 39 39 TYPE(t_field),POINTER :: f_ps(:) 40 TYPE(t_field),POINTER :: f_phis(:)41 40 TYPE(t_field),POINTER :: f_theta_rhodz(:) 42 41 TYPE(t_field),POINTER :: f_u(:) … … 63 62 REAL(rstd),INTENT(IN) :: tt ! current time 64 63 REAL(rstd),INTENT(OUT) :: ue(iim*3*jjm,llm) 65 REAL(rstd) :: lon, lat66 64 REAL(rstd) :: nx(3),n_norm,Velocity(3,llm) 67 REAL(rstd) :: rr1,rr2,bb,cc,aa,hmx68 REAL(rstd) :: v1(3),v2(3),ny(3)69 65 INTEGER :: i,j,n,l 70 66 REAL(rstd) :: pitbytau,kk, pr, zr, u0, u1, v0 -
codes/icosagcm/trunk/src/dcmip/physics_dcmip.f90
r548 r899 5 5 INTEGER,SAVE :: testcase 6 6 !$OMP THREADPRIVATE(testcase) 7 8 TYPE(t_field),POINTER :: f_out_i(:)9 REAL(rstd),POINTER :: out_i(:,:)10 7 11 8 TYPE(t_field),POINTER :: f_precl(:) -
codes/icosagcm/trunk/src/dcmip/physics_dcmip2016.f90
r548 r899 5 5 INTEGER,SAVE :: testcase 6 6 !$OMP THREADPRIVATE(testcase) 7 8 TYPE(t_field),SAVE,POINTER :: f_out_i(:)9 REAL(rstd),SAVE,POINTER :: out_i(:,:)10 7 11 8 TYPE(t_field),SAVE,POINTER :: f_precl(:) -
codes/icosagcm/trunk/src/diagnostics/check_conserve.f90
r649 r899 17 17 AAM_mass_source(3), AAM_vel_source(3) ! read/written only IF is_master 18 18 REAL(rstd),SAVE :: AAM_vel_plus_source(3), AAM_vel_minus_source(3) 19 REAL(rstd),SAVE :: mtot0,ztot0,etot0,angtot0,stot0 ,rmsvtot020 !$OMP THREADPRIVATE(check_type, mtot0,ztot0,etot0,angtot0,stot0 ,rmsvtot0)19 REAL(rstd),SAVE :: mtot0,ztot0,etot0,angtot0,stot0 20 !$OMP THREADPRIVATE(check_type, mtot0,ztot0,etot0,angtot0,stot0) 21 21 22 22 PUBLIC :: init_check_conserve, check_conserve_detailed, check_conserve … … 66 66 67 67 REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 68 INTEGER :: ind ,ierr68 INTEGER :: ind 69 69 REAL(rstd) :: mtot, angtot, rmsdpdt 70 70 REAL(rstd) :: etot, stot, ang_mass, ang_vel, ang_velp, ang_velm, rmsvtot, ztot … … 171 171 172 172 REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 173 INTEGER::ind ,ierr174 REAL(rstd) :: mtot, ztot, rmsdpdt,etot,stot,rmsv, ang_mass, ang_vel, ang_velp, ang_velm173 INTEGER::ind 174 REAL(rstd) :: etot,stot,rmsv, ang_mass, ang_vel, ang_velp, ang_velm 175 175 176 176 IF(check_type == check_detailed) THEN … … 246 246 INTEGER :: ind,i,j,ij 247 247 REAL :: mloc, rmsloc 248 REAL :: mloc_mpi, rmsloc_mpi249 248 250 249 mloc=0.0; rmsloc=0.0 … … 378 377 REAL(rstd), POINTER :: rhodz(:,:) 379 378 INTEGER :: ind 380 REAL(rstd) :: z ,z_mpi379 REAL(rstd) :: z 381 380 382 381 z=0 … … 400 399 REAL(rstd)::qv1,qv2 401 400 REAL(rstd)::hv1,hv2 402 INTEGER :: i,j,ij,l ,ij2401 INTEGER :: i,j,ij,l 403 402 404 403 hv1 = 0.0 ; hv2 = 0.0 -
codes/icosagcm/trunk/src/diagnostics/geopotential_mod.f90
r548 r899 13 13 TYPE(t_field), POINTER :: f_ps(:), f_phis(:), f_theta_rhodz(:), & ! IN 14 14 f_p(:), f_theta(:), f_phi(:) ! OUT 15 REAL(rstd),POINTER :: p k(:,:), p(:,:), theta(:,:,:), theta_rhodz(:,:,:), &15 REAL(rstd),POINTER :: p(:,:), theta(:,:,:), theta_rhodz(:,:,:), & 16 16 phi(:,:), phis(:), ps(:) 17 17 INTEGER :: ind -
codes/icosagcm/trunk/src/diagnostics/kinetic.f90
r548 r899 134 134 REAL(rstd),INTENT(OUT):: Ki(iim*jjm,llm) 135 135 REAL(rstd) :: Kv(2*iim*jjm,llm) 136 INTEGER :: ij,l , u_up, u_down136 INTEGER :: ij,l 137 137 138 138 CALL compute_kv(ue,Kv) -
codes/icosagcm/trunk/src/diagnostics/observable.f90
r668 r899 230 230 INTEGER :: ij,l 231 231 REAL(rstd) :: F_el(3*iim*jjm,llm+1) 232 REAL(rstd) :: uu_right, uu_lup, uu_ldown,W_el, DePhil232 REAL(rstd) :: W_el, DePhil 233 233 ! NB : u and uh are not in DEC form, they are normal components 234 234 ! => we must divide by de -
codes/icosagcm/trunk/src/dissip/dissip_gcm.f90
r890 r899 84 84 CHARACTER(len=255) :: rayleigh_friction_key 85 85 REAL(rstd) :: mintau 86 INTEGER :: seed_size87 INTEGER,ALLOCATABLE :: seed(:)88 86 89 87 ! New variables added for dissipation vertical profile (SF, 19/09/18) … … 592 590 SUBROUTINE relax(shift_t, shift_u) 593 591 USE dcmip_initial_conditions_test_1_2_3 594 REAL(rstd) :: z, ulon,ulat, lon,lat,& ! input to test2_schaer_mountain592 REAL(rstd) :: z, ulon,ulat, & ! input to test2_schaer_mountain 595 593 p,hyam,hybm,w,t,phis,ps,rho,q, & ! unused input/output to test2_schaer_mountain 596 594 fz, u3d(3), uref -
codes/icosagcm/trunk/src/dissip/guided_mod.f90
r548 r899 35 35 REAL(rstd), INTENT(IN):: tt 36 36 TYPE(t_field),POINTER :: f_ps(:) 37 TYPE(t_field),POINTER :: f_phis(:)38 37 TYPE(t_field),POINTER :: f_theta_rhodz(:) 39 38 TYPE(t_field),POINTER :: f_u(:) -
codes/icosagcm/trunk/src/dynamics/caldyn.f90
r580 r899 3 3 PRIVATE 4 4 SAVE 5 CHARACTER(LEN=255) ,SAVE:: caldyn_type5 CHARACTER(LEN=255) :: caldyn_type 6 6 !$OMP THREADPRIVATE(caldyn_type) 7 7 -
codes/icosagcm/trunk/src/dynamics/caldyn_adv.f90
r548 r899 118 118 119 119 INTEGER :: i,j,ij,l 120 LOGICAL,SAVE :: first=.TRUE.121 120 122 121 ALLOCATE(rhodz(iim*jjm,llm)) -
codes/icosagcm/trunk/src/dynamics/caldyn_gcm.F90
r599 r899 144 144 REAL(rstd),POINTER :: wwuu(:,:) 145 145 146 INTEGER :: ind,i ,j,ij,l146 INTEGER :: ind,ij 147 147 148 148 IF (is_omp_first_level) THEN -
codes/icosagcm/trunk/src/dynamics/caldyn_kernels.f90
r548 r899 15 15 REAL(rstd) :: ulon(iim*3*jjm) 16 16 REAL(rstd) :: ulat(iim*3*jjm) 17 REAL(rstd) :: lon,lat18 17 INTEGER :: ij 19 18 DO ij=ij_begin_ext,ij_end_ext … … 44 43 REAL(rstd),INTENT(OUT) :: qv(iim*2*jjm,llm) 45 44 46 INTEGER :: i ,j,ij,l45 INTEGER :: ij,l 47 46 REAL(rstd) :: etav,hv, m 48 47 CALL trace_start("compute_pvort") … … 130 129 REAL(rstd),INTENT(OUT) :: du(iim*3*jjm,llm) 131 130 132 REAL(rstd) :: cor_NT(iim*jjm,llm) ! NT coriolis force u.(du/dPhi)133 REAL(rstd) :: urel(3*iim*jjm,llm) ! relative velocity131 !REAL(rstd) :: cor_NT(iim*jjm,llm) ! NT coriolis force u.(du/dPhi) 132 !REAL(rstd) :: urel(3*iim*jjm,llm) ! relative velocity 134 133 REAL(rstd) :: Ftheta(3*iim*jjm,llm) ! theta flux 135 134 REAL(rstd) :: berni(iim*jjm,llm) ! Bernoulli function 136 135 REAL(rstd) :: uu_right, uu_lup, uu_ldown 137 136 138 INTEGER :: i ,j,ij,l139 REAL(rstd) :: ww,uu137 INTEGER :: ij,l 138 REAL(rstd) :: uu 140 139 141 140 CALL trace_start("compute_caldyn_horiz") -
codes/icosagcm/trunk/src/dynamics/caldyn_kernels_base.F90
r604 r899 10 10 INTEGER, PARAMETER,PUBLIC :: energy=1, enstrophy=2 11 11 TYPE(t_field),POINTER,PUBLIC :: f_out_u(:), f_qu(:), f_qv(:) 12 REAL(rstd),SAVE,POINTER :: out_u(:,:), p(:,:), qu(:,:)13 !$OMP THREADPRIVATE(out_u, p, qu)14 12 15 13 ! temporary shared variables for caldyn … … 35 33 REAL(rstd),INTENT(INOUT) :: geopot(iim*jjm,llm+1) ! geopotential 36 34 37 INTEGER :: i ,j,ij,l35 INTEGER :: ij,l 38 36 REAL(rstd) :: Rd, p_ik, exner_ik, temp_ik, qv, chi, Rmix, gv 39 37 INTEGER :: ij_omp_begin_ext, ij_omp_end_ext … … 182 180 183 181 ! temporary variable 184 INTEGER :: i,j,ij,l,iq 185 REAL(rstd) :: p_ik, exner_ik 182 INTEGER ::ij,l,iq 186 183 INTEGER :: ij_omp_begin, ij_omp_end 187 184 -
codes/icosagcm/trunk/src/dynamics/caldyn_kernels_hevi.F90
r604 r899 117 117 REAL(rstd) :: C_ik(iim*jjm,llm) ! Thomas algorithm 118 118 REAL(rstd) :: D_il(iim*jjm,llm+1) ! Thomas algorithm 119 REAL(rstd) :: gamma, rho_ij, X_ij , Y_ij120 REAL(rstd) :: wil,tau2_g, g2, gm2, ml_g2, c2_mik119 REAL(rstd) :: gamma, rho_ij, X_ij 120 REAL(rstd) :: tau2_g, g2, gm2, ml_g2, c2_mik 121 121 122 122 INTEGER :: iter, ij, l, ij_omp_begin_ext, ij_omp_end_ext … … 133 133 tau2_g=tau*tau/g 134 134 g2=g*g 135 gm2 = g** -2135 gm2 = g**(-2) 136 136 gamma = 1./(1.-kappa) 137 137 … … 256 256 PRINT *, '[hevi_solver] C,D', iter, MAXVAL(ABS(C_ik)),MAXVAL(ABS(D_il)) 257 257 DO l=1,llm+1 258 WRITE(*,'(A,I2.1,I3.2,E9.2)') ,'[hevi_solver] x', iter,l, MAXVAL(ABS(x_il(:,l)))258 WRITE(*,'(A,I2.1,I3.2,E9.2)') '[hevi_solver] x', iter,l, MAXVAL(ABS(x_il(:,l))) 259 259 END DO 260 260 END IF … … 282 282 REAL(rstd) :: berni(iim*jjm,llm) ! (W/m_il)^2 283 283 REAL(rstd) :: berni1(iim*jjm) ! (W/m_il)^2 284 REAL(rstd) :: gamma, rho_ij, T_ij, X_ij, Y_ij,vreff, Rd, Cvd284 REAL(rstd) :: gamma, rho_ij, T_ij, X_ij, vreff, Rd, Cvd 285 285 INTEGER :: ij, l 286 286 … … 401 401 REAL(rstd) :: berniv(iim*jjm,llm) ! moist Bernoulli function 402 402 403 INTEGER :: i ,j,ij,l403 INTEGER :: ij,l 404 404 REAL(rstd) :: Rd, qv, temp, chi, nu, due, due_right, due_lup, due_ldown 405 405 … … 525 525 REAL(rstd) :: Ftheta(3*iim*jjm,llm) ! potential temperature flux 526 526 REAL(rstd) :: uu_right, uu_lup, uu_ldown, du_trisk, divF 527 INTEGER :: ij,iq,l ,kdown527 INTEGER :: ij,iq,l 528 528 529 529 CALL trace_start("compute_caldyn_Coriolis") -
codes/icosagcm/trunk/src/icosa_init.f90
r891 r899 85 85 IMPLICIT NONE 86 86 TYPE(t_field),POINTER,SAVE :: sum_ne(:) 87 TYPE(t_field),POINTER,SAVE :: sum_ne_glo(:)88 87 REAL(rstd),POINTER :: pt_sum_ne(:) 89 INTEGER :: ind,i,j,k,n 90 REAL(rstd) :: vect(3,6) 91 REAL(rstd) :: centr(3),dist 88 INTEGER :: ind,i,j,k,n 92 89 REAL(rstd) :: tot_sum=0 93 90 -
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 -
codes/icosagcm/trunk/src/kernels/compute_NH_geopot.k90
r580 r899 107 107 PRINT *, '[hevi_solver] C,D', iter, MAXVAL(ABS(C_ik)),MAXVAL(ABS(D_il)) 108 108 DO l=1,llm+1 109 WRITE(*,'(A,I2.1,I3.2,E9.2)') ,'[hevi_solver] x_il', iter,l, MAXVAL(ABS(x_il(l,:)))109 WRITE(*,'(A,I2.1,I3.2,E9.2)') '[hevi_solver] x_il', iter,l, MAXVAL(ABS(x_il(l,:))) 110 110 END DO 111 111 DO l=1,llm+1 112 WRITE(*,'(A,I2.1,I3.2,E9.2)') ,'[hevi_solver] R_il', iter,l, MAXVAL(ABS(R_il(l,:)))112 WRITE(*,'(A,I2.1,I3.2,E9.2)') '[hevi_solver] R_il', iter,l, MAXVAL(ABS(R_il(l,:))) 113 113 END DO 114 114 END IF -
codes/icosagcm/trunk/src/output/netcdf_mod.F90
r803 r899 81 81 integer, intent(out) :: varid 82 82 integer :: nf90_def_var 83 nf90_def_var = 0 83 84 end function nf90_def_var 84 85 … … 89 90 integer, dimension(:), optional, intent( in) :: start, count, stride, map 90 91 integer :: nf90_put_var_int0 92 nf90_put_var_int0 = 0 91 93 end function nf90_put_var_int0 92 94 … … 96 98 integer, dimension(:), optional, intent( in) :: start, count, stride, map 97 99 integer :: nf90_put_var_int1 100 nf90_put_var_int1 = 0 98 101 end function nf90_put_var_int1 99 102 … … 103 106 integer, dimension(:), optional, intent( in) :: start, count, stride, map 104 107 integer :: nf90_put_var_int2 108 nf90_put_var_int2 = 0 105 109 end function nf90_put_var_int2 106 110 … … 110 114 integer, dimension(:), optional, intent( in) :: start, count, stride, map 111 115 integer :: nf90_put_var_int3 116 nf90_put_var_int3 = 0 112 117 end function nf90_put_var_int3 113 118 … … 116 121 real, intent( in) :: values 117 122 integer, dimension(:), optional, intent( in) :: start, count, stride, map 118 integer :: nf90_put_var_real0 123 integer :: nf90_put_var_real0 124 nf90_put_var_real0 = 0 119 125 end function nf90_put_var_real0 120 126 … … 123 129 real, intent( in) :: values(:) 124 130 integer, dimension(:), optional, intent( in) :: start, count, stride, map 125 integer :: nf90_put_var_real1 131 integer :: nf90_put_var_real1 132 nf90_put_var_real1 = 0 126 133 end function nf90_put_var_real1 127 134 … … 130 137 real, intent( in) :: values(:,:) 131 138 integer, dimension(:), optional, intent( in) :: start, count, stride, map 132 integer :: nf90_put_var_real2 139 integer :: nf90_put_var_real2 140 nf90_put_var_real2 = 0 133 141 end function nf90_put_var_real2 134 142 … … 137 145 real, intent( in) :: values(:,:,:) 138 146 integer, dimension(:), optional, intent( in) :: start, count, stride, map 139 integer :: nf90_put_var_real3 147 integer :: nf90_put_var_real3 148 nf90_put_var_real3 = 0 140 149 end function nf90_put_var_real3 141 150 … … 146 155 integer, dimension(:), optional, intent( in) :: start, count, stride, map 147 156 integer :: nf90_get_var_int0 157 nf90_get_var_int0 = 0 148 158 end function nf90_get_var_int0 149 159 … … 153 163 integer, dimension(:), optional, intent( in) :: start, count, stride, map 154 164 integer :: nf90_get_var_int1 165 nf90_get_var_int1 = 0 155 166 end function nf90_get_var_int1 156 167 … … 160 171 integer, dimension(:), optional, intent( in) :: start, count, stride, map 161 172 integer :: nf90_get_var_int2 173 nf90_get_var_int2 = 0 162 174 end function nf90_get_var_int2 163 175 … … 167 179 integer, dimension(:), optional, intent( in) :: start, count, stride, map 168 180 integer :: nf90_get_var_int3 181 nf90_get_var_int3 = 0 169 182 end function nf90_get_var_int3 170 183 … … 173 186 real, intent( out) :: values 174 187 integer, dimension(:), optional, intent( in) :: start, count, stride, map 175 integer :: nf90_get_var_real0 188 integer :: nf90_get_var_real0 189 nf90_get_var_real0 = 0 176 190 end function nf90_get_var_real0 177 191 … … 180 194 real, intent( out) :: values(:) 181 195 integer, dimension(:), optional, intent( in) :: start, count, stride, map 182 integer :: nf90_get_var_real1 196 integer :: nf90_get_var_real1 197 nf90_get_var_real1 = 0 183 198 end function nf90_get_var_real1 184 199 … … 187 202 real, intent( out) :: values(:,:) 188 203 integer, dimension(:), optional, intent( in) :: start, count, stride, map 189 integer :: nf90_get_var_real2 204 integer :: nf90_get_var_real2 205 nf90_get_var_real2 = 0 190 206 end function nf90_get_var_real2 191 207 … … 194 210 real, intent( out) :: values(:,:,:) 195 211 integer, dimension(:), optional, intent( in) :: start, count, stride, map 196 integer :: nf90_get_var_real3 212 integer :: nf90_get_var_real3 213 nf90_get_var_real3 = 0 197 214 end function nf90_get_var_real3 198 215 -
codes/icosagcm/trunk/src/output/output_field.f90
r667 r899 7 7 PRIVATE 8 8 9 LOGICAL ,SAVE:: xios_output9 LOGICAL :: xios_output 10 10 !$OMP THREADPRIVATE(xios_output) 11 LOGICAL ,SAVE:: enable_io11 LOGICAL :: enable_io 12 12 !$OMP THREADPRIVATE(enable_io) 13 13 -
codes/icosagcm/trunk/src/output/restart.f90
r893 r899 60 60 61 61 TYPE(t_domain),POINTER :: d 62 TYPE(t_field),POINTER :: field_glo(:)63 62 TYPE(t_field),POINTER :: field(:) 64 63 … … 421 420 INTEGER :: fieldId(20) 422 421 423 TYPE(t_domain),POINTER :: d424 TYPE(t_field),POINTER :: field_glo(:)425 422 TYPE(t_field),POINTER :: field(:) 426 423 427 424 CHARACTER(LEN=255) :: start_file_name 428 425 INTEGER,PARAMETER :: nvert=6 429 INTEGER :: ncid , cellId, levId, edgeId, vertid, lonId, latId, bounds_lonId, bounds_latId430 INTEGER :: ind,ind_glo,i,j,k,nf426 INTEGER :: ncid 427 INTEGER :: nf 431 428 INTEGER :: status 432 REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)433 429 REAL(rstd) :: it_real 434 430 … … 464 460 ! CALL xios_recv_field("it_start",it_real) 465 461 CALL xios_read_var("it_start",it_real) 466 it= it_real462 it=INT(it_real) 467 463 ELSE 468 464 -
codes/icosagcm/trunk/src/output/write_field.f90
r548 r899 350 350 REAL(r8),ALLOCATABLE :: field_val2d(:) 351 351 REAL(r8),ALLOCATABLE :: field_val3d(:,:) 352 REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)353 352 LOGICAL, INTENT(IN) :: once 354 353 TYPE(t_domain),POINTER :: d 355 354 INTEGER :: Index 356 355 INTEGER :: ind,i,j,k,n,ncell,q 357 INTEGER :: iie,jje,iin,jjn358 356 INTEGER :: status 359 357 CHARACTER(len=255) :: name 360 CHARACTER(len=255) :: str_ind361 358 INTEGER :: ind_b,ind_e 362 359 INTEGER :: halo_size … … 394 391 Index=GetFieldIndex(name) 395 392 else 396 FieldIndex(Index)=FieldIndex(Index)+1 .393 FieldIndex(Index)=FieldIndex(Index)+1 397 394 endif 398 395 … … 629 626 REAL(r8),ALLOCATABLE :: field_val2d(:) 630 627 REAL(r8),ALLOCATABLE :: field_val3d(:,:) 631 REAL(r8),ALLOCATABLE :: field_val4d(:,:,:)632 628 TYPE(t_domain),POINTER :: d 633 629 INTEGER :: Index 634 630 INTEGER :: ind,i,j,l,k,n,ncell,q 635 INTEGER :: iie,jje,iin,jjn636 631 INTEGER :: status 637 632 CHARACTER(len=255) :: name 638 CHARACTER(len=255) :: str_ind639 633 INTEGER :: ind_b,ind_e 640 634 INTEGER :: halo_size … … 664 658 Index=GetFieldIndex(name) 665 659 else 666 FieldIndex(Index)=FieldIndex(Index)+1 .660 FieldIndex(Index)=FieldIndex(Index)+1 667 661 endif 668 662 … … 1165 1159 TYPE(t_domain),POINTER :: d 1166 1160 INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId 1167 INTEGER :: dim3id ,dim4id1161 INTEGER :: dim3id 1168 1162 INTEGER :: status 1169 1163 INTEGER :: ind,i,j,k,n,q 1170 INTEGER :: iie,jje,iin,jjn1171 1164 INTEGER :: ind_b,ind_e 1172 1165 INTEGER :: halo_size … … 1174 1167 INTEGER :: nij 1175 1168 CHARACTER(LEN=255) :: name 1176 INTEGER :: l,level_size, levId , dimlevId1169 INTEGER :: l,level_size, levId 1177 1170 1178 1171 name=TRIM(ADJUSTL(name_in)) … … 1477 1470 TYPE(t_domain),POINTER :: d 1478 1471 INTEGER :: nvertId,ncid,lonId,latId,bounds_lonId,bounds_latId,timeId,ncellId 1479 INTEGER :: dim3id ,dim4id1472 INTEGER :: dim3id 1480 1473 INTEGER :: status 1481 1474 INTEGER :: ind,i,j,k,n,q 1482 INTEGER :: iie,jje,iin,jjn1483 1475 INTEGER :: ind_b,ind_e 1484 1476 INTEGER :: halo_size … … 1783 1775 USE netcdf_mod 1784 1776 IMPLICIT NONE 1785 INTEGER :: i, k,status1777 INTEGER :: i,status 1786 1778 !$OMP MASTER 1787 1779 DO i=1,NbField … … 1805 1797 int2str='' 1806 1798 do while (flag) 1807 int2str=CHAR(MOD(i,10)+48)// int2str1799 int2str=CHAR(MOD(i,10)+48)//trim(int2str) 1808 1800 i=i/10 1809 1801 if (i==0) flag=.false. -
codes/icosagcm/trunk/src/output/xios_mod.F90
r888 r899 9 9 LOGICAL,SAVE :: using_xios 10 10 11 #ifdef CPP_USING_XIOS 12 11 13 INTEGER,SAVE :: ncell_i 12 14 !$OMP THREADPRIVATE(ncell_i) … … 17 19 18 20 PRIVATE ncell_i,ncell_v,ncell_e 19 20 #ifdef CPP_USING_XIOS21 21 22 22 CONTAINS -
codes/icosagcm/trunk/src/parallel/domain.f90
r881 r899 83 83 USE ioipsl 84 84 IMPLICIT NONE 85 INTEGER :: ind,nf,ni,nj ,i,j85 INTEGER :: ind,nf,ni,nj 86 86 INTEGER :: quotient, rest 87 87 INTEGER :: halo_i,halo_j … … 176 176 SUBROUTINE copy_domain(d1,d2) 177 177 IMPLICIT NONE 178 INTEGER :: face179 178 TYPE(t_domain),TARGET,INTENT(IN) :: d1 180 179 TYPE(t_domain), INTENT(OUT) :: d2 … … 543 542 544 543 545 block_j= sqrt(nsplit_i*nsplit_j*nb_face*1./mpi_size)544 block_j=INT(sqrt(nsplit_i*nsplit_j*nb_face*1./mpi_size)) 546 545 exit=.FALSE. 547 546 jb=1 … … 625 624 DO i=1,nsplit_i 626 625 ind_glo=ind_glo+1 627 WRITE(*,"(' ',i4.4 ,' |')",ADVANCE='NO') ,domglo_rank(ind_glo)626 WRITE(*,"(' ',i4.4 ,' |')",ADVANCE='NO') domglo_rank(ind_glo) 628 627 END DO 629 628 PRINT *,'' -
codes/icosagcm/trunk/src/parallel/transfert_mpi.f90
r711 r899 100 100 IMPLICIT NONE 101 101 INTEGER :: ind,i,j 102 LOGICAL ::ok103 102 104 103 CALL register_id('MPI', id_mpi) … … 484 483 485 484 INTEGER :: rank,i,j,pos 486 INTEGER :: size_,ind_glo,ind_loc , ind_src485 INTEGER :: size_,ind_glo,ind_loc 487 486 INTEGER :: isend, irecv, ireq, nreq, nsend, nrecv 488 487 INTEGER, ALLOCATABLE :: mpi_req(:) … … 932 931 CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name 933 932 934 TYPE(ARRAY),POINTER :: recv,send935 933 TYPE(t_request),POINTER :: req 936 934 INTEGER :: irecv,isend 937 INTEGER :: ireq,nreq , nreq_send935 INTEGER :: ireq,nreq 938 936 INTEGER :: ind 939 937 INTEGER :: dim3,dim4 940 INTEGER :: i,j941 938 INTEGER,SAVE :: message_number=0 942 939 ! TYPE(t_reorder),POINTER :: reorder(:) … … 1061 1058 TYPE(t_message) :: message 1062 1059 1063 TYPE(t_request),POINTER :: req 1064 INTEGER :: irecv,isend 1065 INTEGER :: ireq,nreq 1066 INTEGER :: ind 1060 INTEGER :: ireq 1067 1061 1068 1062 !$OMP BARRIER … … 1145 1139 TYPE(ARRAY),POINTER :: recv,send 1146 1140 TYPE(t_request),POINTER :: req 1147 INTEGER, ALLOCATABLE :: mpi_req(:)1148 INTEGER, ALLOCATABLE :: status(:,:)1149 1141 INTEGER :: irecv,isend 1150 INTEGER :: ireq ,nreq1151 INTEGER :: ind, i,n,l,m1142 INTEGER :: ireq 1143 INTEGER :: ind,n 1152 1144 INTEGER :: dim3,dim4,d3,d4 1153 1145 INTEGER,POINTER :: src_value(:) 1154 INTEGER,POINTER :: sign(:)1155 1146 INTEGER :: offset,msize,rank 1156 1147 INTEGER :: lbegin, lend … … 1554 1545 INTEGER,POINTER :: value(:) 1555 1546 INTEGER,POINTER :: sgn(:) 1556 TYPE(ARRAY),POINTER :: recv ,send1547 TYPE(ARRAY),POINTER :: recv 1557 1548 TYPE(t_request),POINTER :: req 1558 INTEGER, ALLOCATABLE :: mpi_req(:) 1559 INTEGER, ALLOCATABLE :: status(:,:) 1560 INTEGER :: irecv,isend 1549 INTEGER :: irecv 1561 1550 INTEGER :: ireq,nreq 1562 INTEGER :: ind,n ,l,m,i1551 INTEGER :: ind,n 1563 1552 INTEGER :: dim3,dim4,d3,d4,lbegin,lend 1564 1553 INTEGER :: offset … … 1741 1730 TYPE(t_request),POINTER :: req 1742 1731 INTEGER :: n 1743 REAL(rstd) :: var1,var21744 1732 1745 1733 DO ind=1,ndomain -
codes/icosagcm/trunk/src/physics/physics.f90
r871 r899 11 11 12 12 INTEGER :: phys_type 13 TYPE(t_field),POINTER,SAVE :: f_extra_physics_2D(:), f_extra_physics_3D(:)14 13 TYPE(t_field),POINTER,SAVE :: f_dulon(:), f_dulat(:) 15 14 TYPE(t_field),POINTER,SAVE :: f_ulon(:), f_ulat(:) … … 162 161 TYPE(t_field),POINTER :: f_wflux(:) 163 162 TYPE(t_field),POINTER :: f_q(:) 164 163 165 164 LOGICAL,SAVE :: first=.TRUE. 166 !$OMP THREADPRIVATE(first) 167 168 LOGICAL:: firstcall,lastcall 169 INTEGER :: ind 170 TYPE(t_physics_inout) :: args 171 165 !$OMP THREADPRIVATE(first) 172 166 IF (first) THEN 173 167 CALL init_message(f_theta_rhodz, req_i0, req_theta0) … … 176 170 first=.FALSE. 177 171 ENDIF 178 179 172 180 173 IF (phys_external) THEN 181 174 -
codes/icosagcm/trunk/src/physics/physics_interface.f90
r548 r899 195 195 USE icosa 196 196 IMPLICIT NONE 197 INTEGER :: ind , offset197 INTEGER :: ind 198 198 DO ind=1,ndomain 199 199 IF (.NOT. assigned_domain(ind)) CYCLE -
codes/icosagcm/trunk/src/sphere/geometry.f90
r882 r899 185 185 IMPLICIT NONE 186 186 REAL(rstd) :: x1(3),x2(3) 187 REAL(rstd) :: vect(3,6)188 REAL(rstd) :: centr(3)189 187 INTEGER :: ind,i,j,n,k 190 188 TYPE(t_message),SAVE :: message0, message1 … … 433 431 REAL(rstd) :: vect(3,6) 434 432 REAL(rstd) :: centr(3) 435 REAL(rstd) :: vet(3),vep(3) , vertex(3)433 REAL(rstd) :: vet(3),vep(3) 436 434 INTEGER :: ind,i,j,k,n 437 435 TYPE(t_domain),POINTER :: d … … 440 438 REAL(rstd) :: lon,lat 441 439 INTEGER :: ii_glo,jj_glo 442 REAL(rstd) :: S443 440 444 441 -
codes/icosagcm/trunk/src/sphere/metric.f90
r711 r899 117 117 REAL(rstd) :: rot=0. 118 118 INTEGER :: nf,i,j 119 REAL(rstd),DIMENSION(3) :: p1 ,p2,p3119 REAL(rstd),DIMENSION(3) :: p1 120 120 REAL(rstd) :: d1,d2,d3 121 121 … … 180 180 REAL(rstd) :: rot=0. 181 181 INTEGER :: nf,i,j 182 REAL(rstd),DIMENSION(3) :: p1,p2,p3183 REAL(rstd) :: d1,d2,d3184 182 185 183 len_edge=acos(cos(Pi/5)*cos(2*Pi/5)/(sin(Pi/5)*sin(2*Pi/5))) … … 467 465 INTEGER :: ind,ind2 468 466 INTEGER :: nf,nf2,nfm1,nfp1 469 INTEGER :: i,j,k 470 INTEGER :: delta 467 INTEGER :: i,j 471 468 472 469 ind=0 … … 836 833 SUBROUTINE set_cell_vertex 837 834 IMPLICIT NONE 838 INTEGER :: i,j,k,k2835 INTEGER :: k,k2 839 836 INTEGER :: ind,ind1,ind2 840 837 INTEGER :: ng1,ng2 -
codes/icosagcm/trunk/src/sphere/spherical_geom.f90
r548 r899 28 28 REAL(rstd),INTENT(OUT) :: lat 29 29 30 REAL(rstd) :: coslat31 30 REAL(rstd) :: xyzn(3) 32 31 … … 136 135 REAL(rstd) :: d 137 136 REAL(rstd) :: M(3,3) 138 REAL(rstd) :: alpha(3,3)139 INTEGER :: IPIV(3)140 INTEGER :: info141 137 REAL(rstd) :: xa,xb,xc 142 138 REAL(rstd) :: ya,yb,yc 143 139 REAL(rstd) :: za,zb,zc 144 REAL(rstd) :: alpha_A,alpha_B,alpha_C145 REAL(rstd) :: x,y,z146 REAL(rstd) :: a1,a2,a3147 REAL(rstd) :: b1,b2,b3148 140 149 141 -
codes/icosagcm/trunk/src/sphere/vector.f90
r811 r899 13 13 END FUNCTION Norm 14 14 15 FUNCTION dot_product (V1,V2)15 FUNCTION dot_product_3d(V1,V2) result(dot_product) 16 16 IMPLICIT NONE 17 17 REAL(rstd) :: dot_product … … 21 21 dot_product=V1(1)*V2(1)+V1(2)*V2(2)+V1(3)*V2(3) 22 22 23 END FUNCTION dot_product 23 END FUNCTION dot_product_3d 24 24 25 25 FUNCTION cross_product(Va,Vb) -
codes/icosagcm/trunk/src/time/euler_scheme.f90
r548 r899 36 36 REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:) 37 37 INTEGER :: ind 38 INTEGER :: i ,j,ij,l38 INTEGER :: ij,l 39 39 CALL trace_start("Euler_scheme") 40 40 … … 95 95 REAL(rstd), INTENT(IN) :: tau 96 96 LOGICAL, INTENT(INOUT) :: fluxt_zero 97 INTEGER :: l,i ,j,ij97 INTEGER :: l,ij 98 98 99 99 IF(fluxt_zero) THEN -
codes/icosagcm/trunk/src/time/explicit_scheme.f90
r548 r899 22 22 ! USE caldyn_gcm_mod, ONLY : req_ps, req_mass 23 23 24 REAL(rstd),POINTER :: q(:,:,:) 25 REAL(rstd),POINTER :: phis(:), ps(:) ,psm1(:), psm2(:), dps(:) 24 REAL(rstd),POINTER :: ps(:) ,psm1(:), psm2(:), dps(:) 26 25 REAL(rstd),POINTER :: u(:,:) , um1(:,:), um2(:,:), du(:,:) 27 REAL(rstd),POINTER :: rhodz(:,:), mass(:,:), massm1(:,:), massm2(:,:), dmass(:,:)26 REAL(rstd),POINTER :: mass(:,:), massm1(:,:), dmass(:,:) 28 27 REAL(rstd),POINTER :: theta_rhodz(:,:,:) , theta_rhodzm1(:,:,:), theta_rhodzm2(:,:,:), dtheta_rhodz(:,:,:) 29 28 REAL(rstd),POINTER :: hflux(:,:),wflux(:,:),hfluxt(:,:),wfluxt(:,:) … … 64 63 REAL(rstd), INTENT(IN) :: coef(:) 65 64 REAL(rstd) :: tau 66 INTEGER :: i ,j,ij,l65 INTEGER :: ij,l 67 66 68 67 CALL trace_start("RK_scheme") -
codes/icosagcm/trunk/src/time/time.f90
r706 r899 54 54 run_length=dt*itaumax 55 55 CALL getin('run_length',run_length) 56 itaumax= run_length/dt56 itaumax=INT(run_length/dt) 57 57 58 58 time_style='dcmip' -
codes/icosagcm/trunk/src/time/timeloop_gcm.f90
r895 r899 194 194 195 195 REAL(rstd) :: adv_over_out ! ratio itau_adv/itau_out 196 INTEGER :: ind, it, i,j,l,n, stage196 INTEGER :: ind, it,l 197 197 LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating mass fluxes in time 198 198 LOGICAL, PARAMETER :: check_rhodz=.FALSE. … … 401 401 elapsed = (stop_clock-start_clock)*1./rate_clock 402 402 per_step = elapsed/(it-itau0) 403 throughput = dt/per_step403 throughput = INT(dt/per_step) 404 404 total = per_step*itaumax 405 405 WRITE(*,'(A,I5,A,F6.2,A,I6)') 'Time spent (s):',INT(elapsed), & -
codes/icosagcm/trunk/src/transport/advect.F90
r896 r899 59 59 REAL(rstd),INTENT(OUT) :: gradq3d(iim*jjm,llm,3) 60 60 REAL(rstd) :: maxq,minq,minq_c,maxq_c 61 REAL(rstd) :: alphamx,alphami,alpha ,maggrd 62 REAL(rstd) :: leng1,leng2 61 REAL(rstd) :: alphamx,alphami,alpha,maggrd 63 62 REAL(rstd) :: arr(2*iim*jjm) 64 63 REAL(rstd) :: ar(iim*jjm) 65 64 REAL(rstd) :: gradtri(2*iim*jjm,llm,3) 66 INTEGER :: ij,k, ind,l65 INTEGER :: ij,k,l 67 66 REAL(rstd) :: detx,dety,detz,det 68 67 REAL(rstd) :: A(3,3), a11,a12,a13,a21,a22,a23,a31,a32,a33 … … 243 242 !DIR$ SIMD 244 243 DO ij=ij_begin,ij_end 245 ! maggrd = dot_product (gradq3d(ij,l,:),gradq3d(ij,l,:))244 ! maggrd = dot_product_3d(gradq3d(ij,l,:),gradq3d(ij,l,:)) 246 245 maggrd = gradq3d(ij,l,1)*gradq3d(ij,l,1) + gradq3d(ij,l,2)*gradq3d(ij,l,2) + gradq3d(ij,l,3)*gradq3d(ij,l,3) 247 246 maggrd = sqrt(maggrd) … … 275 274 REAL(rstd), INTENT(OUT) :: dq1,dq2,dq3,det 276 275 REAL(rstd) :: dq(3) 277 278 REAL(rstd) ::detx,dety,detz279 INTEGER :: info280 INTEGER :: IPIV(3)281 276 282 277 REAL(rstd) :: A(3,3) 283 REAL(rstd) :: B(3)284 278 285 279 ! TODO : replace A by A1,A2,A3 … … 345 339 REAL(rstd),INTENT(IN) :: tau 346 340 347 REAL(rstd) :: v_e(3), up_e , qe, ed(3)341 REAL(rstd) :: v_e(3), up_e 348 342 INTEGER :: ij,l 349 343 … … 422 416 REAL(rstd), INTENT(INOUT) :: qfluxt(3*iim*jjm,MERGE(llm,1,diagflux_on)) ! time-integrated tracer flux 423 417 424 REAL(rstd) :: dq,dmass,qe, ed(3),newmass418 REAL(rstd) :: dq,dmass,qe, newmass 425 419 REAL(rstd) :: qflux(3*iim*jjm,llm) 426 INTEGER :: ij, k,l420 INTEGER :: ij,l 427 421 428 422 CALL trace_start("compute_advect_horiz") -
codes/icosagcm/trunk/src/transport/advect_tracer.f90
r599 r899 242 242 243 243 REAL(rstd) :: dzqmax, newmass, sigw, qq, w 244 INTEGER :: i ,ij,l,j,ijb,ije244 INTEGER :: ij,l,ijb,ije 245 245 246 246 CALL trace_start("vlz") -
codes/icosagcm/trunk/src/vertical/disvert_strato.f90
r606 r899 75 75 SUBROUTINE init_disvert_strato_custom 76 76 REAL(rstd) :: vert_scale,vert_dzmin,vert_dzlow,vert_z0low,vert_dzmid,vert_z0mid,vert_h_mid,vert_dzhig,vert_z0hig,vert_h_hig 77 REAL(rstd) :: z, s norm, dsig(llm), sig(llm+1), sig0(llm+1), zz(llm+1)77 REAL(rstd) :: z, sig(llm+1), sig0(llm+1), zz(llm+1) 78 78 INTEGER :: l 79 79 ALLOCATE(ap(llm+1)) … … 181 181 ! Local variables: 182 182 INTEGER :: it, ns, maxit 183 REAL(rstd) :: c1, c2, x1, x2, x3, x4, f1, f2, f3, f4, s, xx, distrib183 REAL(rstd) :: c1, c2, f1 184 184 !------------------------------------------------------------------------------- 185 185 ns=SIZE(sig); maxit=100 -
codes/icosagcm/trunk/tools/ioipsl/calendar.f90
r11 r899 363 363 ss = INT(dd)*one_day+dd-INT(dd) 364 364 itau = itau+NINT(ss/dt) 365 tmp_str = t mp_str(y_pos+1:LEN_TRIM(tmp_str))365 tmp_str = trim(tmp_str(y_pos+1:)) 366 366 ELSE IF (m_pos > 0) THEN 367 367 WRITE(fmt,'("(I",I10.10,")")') m_pos-1 … … 371 371 ss = INT(dd)*one_day+dd-INT(dd) 372 372 itau = itau+NINT(ss/dt) 373 tmp_str = t mp_str(m_pos+1:LEN_TRIM(tmp_str))373 tmp_str = trim(tmp_str(m_pos+1:)) 374 374 ELSE IF (d_pos > 0) THEN 375 375 WRITE(fmt,'("(I",I10.10,")")') d_pos-1 376 376 READ(tmp_str(1:d_pos-1),fmt) read_time 377 377 itau = itau+NINT(read_time*one_day/dt) 378 tmp_str = t mp_str(d_pos+1:LEN_TRIM(tmp_str))378 tmp_str = trim(tmp_str(d_pos+1:)) 379 379 ELSE IF (h_pos > 0) THEN 380 380 WRITE(fmt,'("(I",I10.10,")")') h_pos-1 … … 386 386 READ(tmp_str(1:s_pos-1),fmt) read_time 387 387 itau = itau+NINT(read_time/dt) 388 tmp_str = t mp_str(s_pos+1:LEN_TRIM(tmp_str))388 tmp_str = trim(tmp_str(s_pos+1:)) 389 389 ENDIF 390 390 !- … … 460 460 & ' Please call ioconf_startdate before itau2ymds.') 461 461 ENDIF 462 julian_day = start_day462 julian_day = INT(start_day) 463 463 julian_sec = start_sec+REAL(itau)*deltat 464 464 CALL ju2ymds_internal (julian_day,julian_sec,year,month,day,sec) … … 558 558 date_last_act = itau2date (last_action,date0,dt) 559 559 CALL ju2ymds (date_last_act,year,month,day,sec) 560 monthp1 = month-freq560 monthp1 = INT(month-freq) 561 561 yearp = year 562 562 !- … … 575 575 !---- then we will take it as it is better. 576 576 !- 577 monthp1 = month+ABS(freq)577 monthp1 = INT(month+ABS(freq)) 578 578 yearp=year 579 579 IF (monthp1 >= 13) THEN -
codes/icosagcm/trunk/tools/ioipsl/getincom.f90
r11 r899 659 659 INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err 660 660 CHARACTER(LEN=n_d_fmt) :: cnt 661 CHARACTER(LEN= 80) :: str_READ,str_READ_lower661 CHARACTER(LEN=100) :: str_READ,str_READ_lower 662 662 CHARACTER(LEN=9) :: c_vtyp 663 663 LOGICAL,DIMENSION(:),ALLOCATABLE :: found … … 1416 1416 !- 1417 1417 TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab 1418 CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)1419 1418 !- 1420 1419 INTEGER :: ier
Note: See TracChangeset
for help on using the changeset viewer.