Changeset 1027 for codes/icosagcm/devel/src
- Timestamp:
- 05/18/20 21:07:49 (4 years ago)
- Location:
- codes/icosagcm/devel/src
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/diagnostics/compute_diagnostics.f90
r958 r1027 5 5 PRIVATE 6 6 7 ! fake array dimensions, for interfaces8 INTEGER, PARAMETER :: iim_jjm_i=1, iim_jjm_u=1, iim_jjm_v=1, llm_=1, llm1=1, nqdyn_=19 10 7 INTERFACE 11 8 … … 13 10 IMPORT 14 11 LOGICAL, INTENT(IN) :: flag 15 REAL(rstd),INTENT(IN) :: ps( iim_jjm_i)16 REAL(rstd),INTENT( OUT) :: rhodz(iim_jjm_i,llm_)12 REAL(rstd),INTENT(IN) :: ps(:) 13 REAL(rstd),INTENT(INOUT) :: rhodz(:,:) 17 14 END SUBROUTINE comp_rhodz 18 15 … … 20 17 IMPORT 21 18 INTEGER, INTENT(IN) :: offset 22 REAL(rstd), INTENT(IN) :: ps( iim_jjm_i)23 REAL(rstd), INTENT(OUT) :: p( iim_jjm_i,llm_)19 REAL(rstd), INTENT(IN) :: ps(:) 20 REAL(rstd), INTENT(OUT) :: p(:,:) 24 21 END SUBROUTINE comp_pression 25 22 26 23 SUBROUTINE comp_temperature(pmid,q,temp) 27 24 IMPORT 28 REAL(rstd),INTENT(IN) :: pmid( iim_jjm_i, llm_)29 REAL(rstd),INTENT(IN) :: q( iim_jjm_i, llm_, nqdyn_)30 REAL(rstd),INTENT(INOUT) :: temp( iim_jjm_i, llm_)25 REAL(rstd),INTENT(IN) :: pmid(:,:) 26 REAL(rstd),INTENT(IN) :: q(:,:,:) 27 REAL(rstd),INTENT(INOUT) :: temp(:,:) 31 28 END SUBROUTINE comp_temperature 32 29 33 30 SUBROUTINE comp_hydro_press(rhodz, theta_rhodz, ps, p) 34 31 IMPORT 35 REAL(rstd),INTENT(IN) :: rhodz( iim_jjm_i, llm_)36 REAL(rstd),INTENT(IN) :: theta_rhodz( iim_jjm_i, llm_, nqdyn_)37 REAL(rstd),INTENT(OUT) :: ps( iim_jjm_i)38 REAL(rstd),INTENT(OUT) :: p( iim_jjm_i, llm_)32 REAL(rstd),INTENT(IN) :: rhodz(:,:) 33 REAL(rstd),INTENT(IN) :: theta_rhodz(:,:,:) 34 REAL(rstd),INTENT(OUT) :: ps(:) 35 REAL(rstd),INTENT(OUT) :: p(:,:) 39 36 END SUBROUTINE comp_hydro_press 40 37 41 38 SUBROUTINE comp_vert_interp(pmid,in,out,pval) 42 39 IMPORT 43 REAL(rstd),INTENT(IN) :: pmid( iim_jjm_i, llm_)44 REAL(rstd),INTENT(IN) :: in( iim_jjm_i, llm_)45 REAL(rstd),INTENT(OUT):: out( iim_jjm_i)40 REAL(rstd),INTENT(IN) :: pmid(:,:) 41 REAL(rstd),INTENT(IN) :: in(:,:) 42 REAL(rstd),INTENT(OUT):: out(:) 46 43 REAL(rstd),INTENT(IN) :: pval 47 44 END SUBROUTINE comp_vert_interp -
codes/icosagcm/devel/src/diagnostics/compute_pression.F90
r956 r1027 109 109 END SUBROUTINE hydrostatic_pressure 110 110 111 !-------------- Wrappers for F2008 conformity ----------------- 112 113 SUBROUTINE compute_pression_hex(ps,p,offset) 114 REAL(rstd),INTENT(IN) :: ps(:) 115 REAL(rstd),INTENT(OUT) :: p(:,:) 116 INTEGER,INTENT(IN) :: offset 117 CALL compute_pression_hex_(ps,p,offset) 118 END SUBROUTINE compute_pression_hex 119 120 SUBROUTINE compute_pression_unst(ps,p,offset) 121 REAL(rstd),INTENT(IN) :: ps(:) 122 REAL(rstd),INTENT(OUT) :: p(:,:) 123 INTEGER,INTENT(IN) :: offset 124 CALL compute_pression_unst_(ps,p,offset) 125 END SUBROUTINE compute_pression_unst 126 127 SUBROUTINE compute_pression_mid_hex(ps,p,offset) 128 REAL(rstd),INTENT(IN) :: ps(:) 129 REAL(rstd),INTENT(OUT) :: p(:,:) 130 INTEGER,INTENT(IN) :: offset 131 CALL compute_pression_mid_hex_(ps,p,offset) 132 END SUBROUTINE compute_pression_mid_hex 133 134 SUBROUTINE compute_pression_mid_unst(ps,p,offset) 135 REAL(rstd),INTENT(IN) :: ps(:) 136 REAL(rstd),INTENT(OUT) :: p(:,:) 137 INTEGER,INTENT(IN) :: offset 138 CALL compute_pression_mid_unst_(ps,p,offset) 139 END SUBROUTINE compute_pression_mid_unst 140 141 SUBROUTINE compute_hydrostatic_pressure_hex(rhodz, theta_rhodz, ps, p) 142 REAL(rstd),INTENT(IN) :: rhodz(:,:), theta_rhodz(:,:,:) 143 REAL(rstd),INTENT(OUT) :: ps(:), p(:,:) 144 CALL compute_hydrostatic_pressure_hex_(rhodz, theta_rhodz, ps, p) 145 END SUBROUTINE compute_hydrostatic_pressure_hex 146 147 SUBROUTINE compute_hydrostatic_pressure_unst(rhodz, theta_rhodz, ps, p) 148 REAL(rstd),INTENT(IN) :: rhodz(:,:), theta_rhodz(:,:,:) 149 REAL(rstd),INTENT(OUT) :: ps(:), p(:,:) 150 CALL compute_hydrostatic_pressure_unst_(rhodz, theta_rhodz, ps, p) 151 END SUBROUTINE compute_hydrostatic_pressure_unst 152 111 153 !------------- hexagonal-mesh compute kernels -------- 112 154 … … 114 156 #define BP(ij,l) bp(l) 115 157 116 SUBROUTINE compute_pression_hex (ps,p,offset)158 SUBROUTINE compute_pression_hex_(ps,p,offset) 117 159 REAL(rstd),INTENT(IN) :: ps(iim*jjm) 118 160 REAL(rstd),INTENT(OUT) :: p(iim*jjm,llm+1) … … 120 162 INTEGER :: ij,l 121 163 #include "../kernels_hex/compute_pression.k90" 122 END SUBROUTINE compute_pression_hex 123 124 SUBROUTINE compute_pression_mid_hex (ps,pmid,offset)164 END SUBROUTINE compute_pression_hex_ 165 166 SUBROUTINE compute_pression_mid_hex_(ps,pmid,offset) 125 167 REAL(rstd),INTENT(IN) :: ps(iim*jjm) 126 168 REAL(rstd),INTENT(OUT) :: pmid(iim*jjm,llm) … … 128 170 INTEGER :: ij,l 129 171 #include "../kernels_hex/compute_pmid.k90" 130 END SUBROUTINE compute_pression_mid_hex 172 END SUBROUTINE compute_pression_mid_hex_ 131 173 132 174 #undef AP 133 175 #undef BP 134 176 135 SUBROUTINE compute_hydrostatic_pressure_hex (rhodz, theta_rhodz, ps, pk)177 SUBROUTINE compute_hydrostatic_pressure_hex_(rhodz, theta_rhodz, ps, pk) 136 178 REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) ! mass per unit surface in each model level 137 179 REAL(rstd),INTENT(IN) :: theta_rhodz(iim*jjm,llm, nqdyn) ! dynamical tracers (theta/entropy) … … 143 185 #include "../kernels_hex/compute_hydrostatic_pressure.k90" 144 186 !$OMP BARRIER 145 END SUBROUTINE compute_hydrostatic_pressure_hex 187 END SUBROUTINE compute_hydrostatic_pressure_hex_ 146 188 147 189 !----------- unstructured-mesh compute kernels -------- … … 150 192 #define BP(l,ij) bp(l) 151 193 152 SUBROUTINE compute_pression_unst (ps, p, offset)194 SUBROUTINE compute_pression_unst_(ps, p, offset) 153 195 FIELD_PS, INTENT(IN) :: ps 154 196 FIELD_GEOPOT, INTENT(OUT) :: p … … 156 198 DECLARE_INDICES 157 199 #include "../kernels_unst/compute_pression.k90" 158 END SUBROUTINE compute_pression_unst 159 160 SUBROUTINE compute_pression_mid_unst (ps, pmid, offset)200 END SUBROUTINE compute_pression_unst_ 201 202 SUBROUTINE compute_pression_mid_unst_(ps, pmid, offset) 161 203 FIELD_PS, INTENT(IN) :: ps 162 204 FIELD_MASS, INTENT(OUT) :: pmid … … 164 206 DECLARE_INDICES 165 207 #include "../kernels_unst/compute_pmid.k90" 166 END SUBROUTINE compute_pression_mid_unst 208 END SUBROUTINE compute_pression_mid_unst_ 167 209 168 210 #undef AP 169 211 #undef BP 170 212 171 SUBROUTINE compute_hydrostatic_pressure_unst (rhodz, theta_rhodz, ps, pk)213 SUBROUTINE compute_hydrostatic_pressure_unst_(rhodz, theta_rhodz, ps, pk) 172 214 FIELD_MASS, INTENT(IN) :: rhodz 173 215 FIELD_THETA, INTENT(IN) :: theta_rhodz … … 176 218 DECLARE_INDICES 177 219 #include "../kernels_unst/compute_hydrostatic_pressure.k90" 178 END SUBROUTINE compute_hydrostatic_pressure_unst 220 END SUBROUTINE compute_hydrostatic_pressure_unst_ 179 221 180 222 -
codes/icosagcm/devel/src/diagnostics/compute_rhodz.F90
r912 r1027 1 1 MODULE compute_rhodz_mod 2 USE icosa, ONLY : rstd 2 3 USE earth_const, ONLY : g 3 4 USE disvert_mod, ONLY : ap, bp … … 41 42 #endif END_DYSL 42 43 44 !-------------- Wrappers for F2008 conformity ----------------- 45 !-------------------------------------------------------------- 46 47 SUBROUTINE compute_rhodz_hex(comp, ps, rhodz) 48 LOGICAL, INTENT(IN) :: comp ! .TRUE. to compute, .FALSE. to check 49 REAL(rstd), INTENT(IN) :: ps(:) 50 REAL(rstd), INTENT(INOUT) :: rhodz(:,:) 51 CALL compute_rhodz_hex_(comp, ps, rhodz) 52 END SUBROUTINE compute_rhodz_hex 53 43 54 SUBROUTINE compute_rhodz_unst(comp, ps, rhodz) 55 LOGICAL, INTENT(IN) :: comp ! .TRUE. to compute, .FALSE. to check 56 REAL(rstd), INTENT(IN) :: ps(:) 57 REAL(rstd), INTENT(INOUT) :: rhodz(:,:) 58 CALL compute_rhodz_unst_(comp, ps, rhodz) 59 END SUBROUTINE compute_rhodz_unst 60 61 !-------------------------------------------------------------- 62 63 SUBROUTINE compute_rhodz_unst_(comp, ps, rhodz) 44 64 USE data_unstructured_mod, ONLY : primal_num 45 65 LOGICAL, INTENT(IN) :: comp … … 53 73 #undef AP 54 74 #undef BP 55 END SUBROUTINE compute_rhodz_unst 75 END SUBROUTINE compute_rhodz_unst_ 56 76 57 SUBROUTINE compute_rhodz_hex (comp, ps, rhodz)77 SUBROUTINE compute_rhodz_hex_(comp, ps, rhodz) 58 78 USE icosa 59 79 USE omp_para … … 68 88 #undef AP 69 89 #undef BP 70 END SUBROUTINE compute_rhodz_hex 90 END SUBROUTINE compute_rhodz_hex_ 71 91 72 92 SUBROUTINE compute_rhodz_handmade(comp, ps, rhodz) -
codes/icosagcm/devel/src/diagnostics/compute_temperature.F90
r952 r1027 1 1 MODULE compute_temperature_mod 2 USE prec, ONLY : rstd 2 3 USE earth_const, ONLY : cpp, cppv, kappa, Rd, Rv, preff, Treff, nu, & 3 4 caldyn_thermo, physics_thermo, thermo_fake_moist, & … … 96 97 #endif END_DYSL 97 98 99 !-------------- Wrappers for F2008 conformity ----------------- 100 98 101 SUBROUTINE compute_temperature_unst(pmid, q, temp) 99 USE prec 102 REAL(rstd),INTENT(IN) :: pmid(:,:), q(:,:,:) 103 REAL(rstd),INTENT(INOUT) :: temp(:,:) 104 CALL compute_temperature_unst_(pmid, q, temp) 105 END SUBROUTINE compute_temperature_unst 106 107 SUBROUTINE compute_temperature_hex(pmid, q, temp) 108 REAL(rstd),INTENT(IN) :: pmid(:,:), q(:,:,:) 109 REAL(rstd),INTENT(INOUT) :: temp(:,:) 110 CALL compute_temperature_hex_(pmid, q, temp) 111 END SUBROUTINE compute_temperature_hex 112 113 !-------------------------------------------------------------- 114 115 SUBROUTINE compute_temperature_unst_(pmid, q, temp) 100 116 REAL(rstd),INTENT(IN) :: pmid(llm, primal_num) 101 117 REAL(rstd),INTENT(IN) :: q(llm, primal_num, nqtot) … … 104 120 DECLARE_INDICES 105 121 #include "../kernels_unst/compute_temperature.k90" 106 END SUBROUTINE compute_temperature_unst 122 END SUBROUTINE compute_temperature_unst_ 107 123 108 SUBROUTINE compute_temperature_hex (pmid,q,temp)124 SUBROUTINE compute_temperature_hex_(pmid,q,temp) 109 125 USE icosa 110 126 USE omp_para … … 116 132 INTEGER :: ij,l 117 133 #include "../kernels_hex/compute_temperature.k90" 118 END SUBROUTINE compute_temperature_hex 134 END SUBROUTINE compute_temperature_hex_ 119 135 120 136 SUBROUTINE compute_temperature_manual(pmid,q,temp) -
codes/icosagcm/devel/src/dynamics/compute_caldyn.f90
r938 r1027 11 11 SUBROUTINE comp_pvort_only(u,rhodz,qu,qv, hv) 12 12 IMPORT 13 REAL(rstd), INTENT(IN) :: u(iim_jjm_i, llm_)14 REAL(rstd), INTENT(INOUT) :: rhodz(iim_jjm_i, llm_)15 REAL(rstd), INTENT(OUT) :: qu(iim_jjm_u, llm_)16 REAL(rstd), INTENT(OUT) :: qv(iim_jjm_v, llm_)17 REAL(rstd), INTENT(OUT) :: hv(iim_jjm_v, llm_)13 REAL(rstd), INTENT(IN) :: u(:,:) 14 REAL(rstd), INTENT(INOUT) :: rhodz(:,:) 15 REAL(rstd), INTENT(OUT) :: qu(:,:) 16 REAL(rstd), INTENT(OUT) :: qv(:,:) 17 REAL(rstd), INTENT(OUT) :: hv(:,:) 18 18 END SUBROUTINE comp_pvort_only 19 19 20 20 SUBROUTINE comp_theta(mass_col,theta_rhodz, rhodz,theta) 21 21 IMPORT 22 REAL(rstd), INTENT(IN) :: mass_col(iim_jjm_i)23 REAL(rstd), INTENT(IN) :: theta_rhodz(iim_jjm_i, llm_, nqdyn_)24 REAL(rstd), INTENT(INOUT) :: rhodz(iim_jjm_i, llm_)25 REAL(rstd), INTENT(OUT) :: theta(iim_jjm_i, llm_, nqdyn_)22 REAL(rstd), INTENT(IN) :: mass_col(:) 23 REAL(rstd), INTENT(IN) :: theta_rhodz(:,:,:) 24 REAL(rstd), INTENT(INOUT) :: rhodz(:,:) 25 REAL(rstd), INTENT(OUT) :: theta(:,:,:) 26 26 END SUBROUTINE comp_theta 27 27 28 28 SUBROUTINE comp_geopot(rhodz,theta, ps,pk,geopot) 29 29 IMPORT 30 REAL(rstd), INTENT(IN) :: rhodz(iim_jjm_i, llm_)! rho*dz = mass per unit surface in each full model level31 REAL(rstd), INTENT(IN) :: theta(iim_jjm_i, llm_, nqdyn_)! active scalars : theta/entropy, moisture, ...32 REAL(rstd), INTENT(INOUT) :: ps(iim_jjm_i)! surface pressure33 REAL(rstd), INTENT(OUT) :: pk(iim_jjm_i, llm_)! Exner function (compressible) /Lagrange multiplier (Boussinesq)34 REAL(rstd), INTENT(INOUT) :: geopot(iim_jjm_i, llm1)! geopotential30 REAL(rstd), INTENT(IN) :: rhodz(:,:) ! rho*dz = mass per unit surface in each full model level 31 REAL(rstd), INTENT(IN) :: theta(:,:,:) ! active scalars : theta/entropy, moisture, ... 32 REAL(rstd), INTENT(INOUT) :: ps(:) ! surface pressure 33 REAL(rstd), INTENT(OUT) :: pk(:,:) ! Exner function (compressible) /Lagrange multiplier (Boussinesq) 34 REAL(rstd), INTENT(INOUT) :: geopot(:,:) ! geopotential 35 35 END SUBROUTINE comp_geopot 36 36 37 37 SUBROUTINE comp_caldyn_fast(tau,theta,geopot, pk,berni,du,u) 38 38 IMPORT 39 REAL(rstd), INTENT(IN) :: tau! "solve" u-tau*du/dt = rhs40 REAL(rstd), INTENT(IN) :: theta(iim_jjm_i, llm_, nqdyn_)41 REAL(rstd), INTENT(IN) :: geopot(iim_jjm_i, llm1)42 REAL(rstd), INTENT(INOUT) :: pk(iim_jjm_i, llm_)43 REAL(rstd), INTENT(INOUT) :: berni(iim_jjm_i, llm_)! partial Bernoulli function44 REAL(rstd), INTENT(INOUT) :: du(iim_jjm_u, llm_)45 REAL(rstd), INTENT(INOUT) :: u(iim_jjm_u, llm_)! INOUT if tau>039 REAL(rstd), INTENT(IN) :: tau ! "solve" u-tau*du/dt = rhs 40 REAL(rstd), INTENT(IN) :: theta(:,:,:) 41 REAL(rstd), INTENT(IN) :: geopot(:,:) 42 REAL(rstd), INTENT(INOUT) :: pk(:,:) 43 REAL(rstd), INTENT(INOUT) :: berni(:,:) ! partial Bernoulli function 44 REAL(rstd), INTENT(INOUT) :: du(:,:) 45 REAL(rstd), INTENT(INOUT) :: u(:,:) ! INOUT if tau>0 46 46 END SUBROUTINE comp_caldyn_fast 47 47 48 48 SUBROUTINE comp_caldyn_slow_hydro(zero, u,rhodz,hv,Kv, berni, hflux,du) 49 49 IMPORT 50 LOGICAL, INTENT(IN):: zero51 REAL(rstd), INTENT(IN) :: u(iim_jjm_u, llm_)! prognostic "velocity"52 REAL(rstd), INTENT(IN) :: rhodz(iim_jjm_i, llm_)53 REAL(rstd), INTENT(IN) :: hv(iim_jjm_v, llm_)! height/mass averaged to vertices54 REAL(rstd), INTENT(IN) :: Kv(iim_jjm_v, llm_)! kinetic energy at vertices55 REAL(rstd), INTENT(OUT) :: berni(iim_jjm_i, llm_) ! Bernoulli function56 REAL(rstd), INTENT(OUT) :: hflux(iim_jjm_u, llm_)! hflux in kg/s57 REAL(rstd), INTENT(INOUT) :: du(iim_jjm_u, llm_)50 LOGICAL, INTENT(IN) :: zero 51 REAL(rstd), INTENT(IN) :: u(:,:) ! prognostic "velocity" 52 REAL(rstd), INTENT(IN) :: rhodz(:,:) 53 REAL(rstd), INTENT(IN) :: hv(:,:) ! height/mass averaged to vertices 54 REAL(rstd), INTENT(IN) :: Kv(:,:) ! kinetic energy at vertices 55 REAL(rstd), INTENT(OUT) :: berni(:,:) ! Bernoulli function 56 REAL(rstd), INTENT(OUT) :: hflux(:,:) ! hflux in kg/s 57 REAL(rstd), INTENT(INOUT) :: du(:,:) 58 58 END SUBROUTINE comp_caldyn_slow_hydro 59 59 60 60 SUBROUTINE comp_caldyn_coriolis(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 61 61 IMPORT 62 REAL(rstd), INTENT(IN) :: hflux(iim_jjm_u, llm_)! hflux in kg/s63 REAL(rstd), INTENT(IN) :: theta(iim_jjm_i, llm_, nqdyn_) ! active scalars64 REAL(rstd), INTENT(IN) :: qu(iim_jjm_u, llm_)65 REAL(rstd), INTENT(OUT) :: Ftheta(iim_jjm_u, llm_) ! potential temperature flux66 REAL(rstd), INTENT(OUT) :: convm(iim_jjm_i, llm_)! mass flux convergence67 REAL(rstd), INTENT(OUT) :: dtheta_rhodz(iim_jjm_i, llm_, nqdyn_)68 REAL(rstd), INTENT(INOUT) :: du(iim_jjm_u, llm_)62 REAL(rstd), INTENT(IN) :: hflux(:,:) ! hflux in kg/s 63 REAL(rstd), INTENT(IN) :: theta(:,:,:) ! active scalars 64 REAL(rstd), INTENT(IN) :: qu(:,:) 65 REAL(rstd), INTENT(OUT) :: Ftheta(:,:) ! potential temperature flux 66 REAL(rstd), INTENT(OUT) :: convm(:,:) ! mass flux convergence 67 REAL(rstd), INTENT(OUT) :: dtheta_rhodz(:,:,:) 68 REAL(rstd), INTENT(INOUT) :: du(:,:) 69 69 END SUBROUTINE comp_caldyn_coriolis 70 70 -
codes/icosagcm/devel/src/dynamics/compute_caldyn_Coriolis.F90
r940 r1027 74 74 #endif END_DYSL 75 75 76 SUBROUTINE compute_caldyn_coriolis_unst(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 76 !-------------- Wrappers for F2008 conformity ----------------- 77 78 SUBROUTINE compute_caldyn_coriolis_unst(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 79 REAL(rstd), INTENT(IN) :: hflux(:,:), theta(:,:,:), qu(:,:) 80 REAL(rstd), INTENT(OUT) :: Ftheta(:,:), convm(:,:), dtheta_rhodz(:,:,:) 81 REAL(rstd), INTENT(INOUT) :: du(:,:) 82 CALL compute_caldyn_coriolis_unst_(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 83 END SUBROUTINE compute_caldyn_coriolis_unst 84 85 SUBROUTINE compute_caldyn_coriolis_hex(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 86 REAL(rstd), INTENT(IN) :: hflux(:,:), theta(:,:,:), qu(:,:) 87 REAL(rstd), INTENT(OUT) :: Ftheta(:,:), convm(:,:), dtheta_rhodz(:,:,:) 88 REAL(rstd), INTENT(INOUT) :: du(:,:) 89 CALL compute_caldyn_coriolis_hex_(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 90 END SUBROUTINE compute_caldyn_coriolis_hex 91 92 !-------------------------------------------------------------- 93 94 SUBROUTINE compute_caldyn_coriolis_unst_(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 77 95 USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT 78 96 USE data_unstructured_mod, ONLY : enter_trace, exit_trace, & … … 89 107 #include "../kernels_unst/coriolis.k90" 90 108 STOP_TRACE 91 END SUBROUTINE compute_caldyn_coriolis_unst 92 93 SUBROUTINE compute_caldyn_Coriolis_hex (hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du)109 END SUBROUTINE compute_caldyn_coriolis_unst_ 110 111 SUBROUTINE compute_caldyn_Coriolis_hex_(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) 94 112 USE icosa 95 113 REAL(rstd),INTENT(IN) :: hflux(3*iim*jjm,llm) ! hflux in kg/s … … 107 125 108 126 CALL trace_end("compute_caldyn_Coriolis") 109 END SUBROUTINE compute_caldyn_Coriolis_hex 127 END SUBROUTINE compute_caldyn_Coriolis_hex_ 110 128 111 129 SUBROUTINE compute_caldyn_Coriolis_manual(hflux,theta,qu, Ftheta, convm,dtheta_rhodz,du) -
codes/icosagcm/devel/src/dynamics/compute_caldyn_fast.F90
r939 r1027 68 68 #endif END_DYSL 69 69 70 !-------------- Wrappers for F2008 conformity ----------------- 71 72 SUBROUTINE compute_caldyn_fast_hex(tau,theta,geopot, pk,berni,du,u) 73 REAL(rstd),INTENT(IN) :: tau, theta(:,:,:), geopot(:,:) 74 REAL(rstd),INTENT(INOUT) :: pk(:,:), berni(:,:), du(:,:), u(:,:) 75 CALL compute_caldyn_fast_hex_(tau,theta,geopot, pk,berni,du,u) 76 END SUBROUTINE compute_caldyn_fast_hex 77 70 78 SUBROUTINE compute_caldyn_fast_unst(tau,theta,geopot, pk,berni,du,u) 79 REAL(rstd),INTENT(IN) :: tau, theta(:,:,:), geopot(:,:) 80 REAL(rstd),INTENT(INOUT) :: pk(:,:), berni(:,:), du(:,:), u(:,:) 81 CALL compute_caldyn_fast_unst_(tau,theta,geopot, pk,berni,du,u) 82 END SUBROUTINE compute_caldyn_fast_unst 83 84 !-------------------------------------------------------------- 85 86 SUBROUTINE compute_caldyn_fast_unst_(tau,theta,geopot, pk,berni,du,u) 71 87 USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT 72 88 USE data_unstructured_mod, ONLY : enter_trace, exit_trace, & … … 84 100 #include "../kernels_unst/caldyn_fast.k90" 85 101 STOP_TRACE 86 END SUBROUTINE compute_caldyn_fast_unst 87 88 SUBROUTINE compute_caldyn_fast_hex (tau,theta,geopot, pk,berni,du,u)102 END SUBROUTINE compute_caldyn_fast_unst_ 103 104 SUBROUTINE compute_caldyn_fast_hex_(tau,theta,geopot, pk,berni,du,u) 89 105 USE icosa 90 106 REAL(rstd),INTENT(IN) :: tau ! "solve" u-tau*du/dt = rhs … … 104 120 CALL trace_end("compute_caldyn_fast") 105 121 106 END SUBROUTINE compute_caldyn_fast_hex 122 END SUBROUTINE compute_caldyn_fast_hex_ 107 123 108 124 SUBROUTINE compute_caldyn_fast_manual(tau,theta,geopot, pk,berni,du,u) -
codes/icosagcm/devel/src/dynamics/compute_caldyn_slow_hydro.F90
r939 r1027 53 53 #endif END_DYSL 54 54 55 !-------------- Wrappers for F2008 conformity ----------------- 56 57 SUBROUTINE compute_caldyn_slow_hydro_hex(zero, u,rhodz,hv,Kv, berni, hflux,du) 58 LOGICAL, INTENT(IN) :: zero 59 REAL(rstd),INTENT(IN) :: u(:,:), rhodz(:,:), hv(:,:), Kv(:,:) 60 REAL(rstd), INTENT(OUT) :: berni(:,:), hflux(:,:) 61 REAL(rstd),INTENT(INOUT) :: du(:,:) 62 CALL compute_caldyn_slow_hydro_hex_(zero, u,rhodz,hv,Kv, berni, hflux,du) 63 END SUBROUTINE compute_caldyn_slow_hydro_hex 64 55 65 SUBROUTINE compute_caldyn_slow_hydro_unst(zero, u,rhodz,hv,Kv, berni, hflux,du) 66 LOGICAL, INTENT(IN) :: zero 67 REAL(rstd),INTENT(IN) :: u(:,:), rhodz(:,:), hv(:,:), Kv(:,:) 68 REAL(rstd), INTENT(OUT) :: berni(:,:), hflux(:,:) 69 REAL(rstd),INTENT(INOUT) :: du(:,:) 70 CALL compute_caldyn_slow_hydro_unst_(zero, u,rhodz,hv,Kv, berni, hflux,du) 71 END SUBROUTINE compute_caldyn_slow_hydro_unst 72 73 !-------------------------------------------------------------- 74 75 SUBROUTINE compute_caldyn_slow_hydro_unst_(zero, u,rhodz,hv,Kv, berni, hflux,du) 56 76 USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT 57 77 USE data_unstructured_mod, ONLY : enter_trace, exit_trace, & … … 66 86 #include "../kernels_unst/caldyn_slow_hydro.k90" 67 87 STOP_TRACE 68 END SUBROUTINE compute_caldyn_slow_hydro_unst 69 70 SUBROUTINE compute_caldyn_slow_hydro_hex (zero, u,rhodz,hv,Kv, berni, hflux,du)88 END SUBROUTINE compute_caldyn_slow_hydro_unst_ 89 90 SUBROUTINE compute_caldyn_slow_hydro_hex_(zero, u,rhodz,hv,Kv, berni, hflux,du) 71 91 USE icosa 72 92 USE caldyn_vars_mod … … 89 109 CALL trace_end("compute_caldyn_slow_hydro") 90 110 91 END SUBROUTINE compute_caldyn_slow_hydro_hex 111 END SUBROUTINE compute_caldyn_slow_hydro_hex_ 92 112 93 113 SUBROUTINE compute_caldyn_slow_hydro_manual(zero, u,rhodz,hv,Kv, berni, hflux,du) -
codes/icosagcm/devel/src/dynamics/compute_geopot.F90
r955 r1027 126 126 #endif END_DYSL 127 127 128 !-------------- Wrappers for F2008 conformity ----------------- 129 !-------------------------------------------------------------- 130 131 SUBROUTINE compute_geopot_hex(rhodz,theta, ps,pk,geopot) 132 REAL(rstd),INTENT(IN) :: rhodz(:,:), theta(:,:,:) ! active scalars : theta/entropy, moisture, ... 133 REAL(rstd),INTENT(INOUT) :: ps(:), geopot(:,:) ! geopotential 134 REAL(rstd),INTENT(OUT) :: pk(:,:) ! Exner function (compressible) /Lagrange multiplier (Boussinesq) 135 CALL compute_geopot_hex_(rhodz,theta, ps,pk,geopot) 136 END SUBROUTINE compute_geopot_hex 137 138 SUBROUTINE compute_geopot_unst(rhodz,theta, ps,pk,geopot) 139 REAL(rstd),INTENT(IN) :: rhodz(:,:), theta(:,:,:) ! active scalars : theta/entropy, moisture, ... 140 REAL(rstd),INTENT(INOUT) :: ps(:), geopot(:,:) ! geopotential 141 REAL(rstd),INTENT(OUT) :: pk(:,:) ! Exner function (compressible) /Lagrange multiplier (Boussinesq) 142 CALL compute_geopot_unst_(rhodz,theta, ps,pk,geopot) 143 END SUBROUTINE compute_geopot_unst 144 128 145 !**************************** Geopotential ***************************** 129 146 130 SUBROUTINE compute_geopot_unst (rhodz,theta,ps,pk,geopot)147 SUBROUTINE compute_geopot_unst_(rhodz,theta,ps,pk,geopot) 131 148 USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT 132 149 USE data_unstructured_mod, ONLY : enter_trace, exit_trace, & … … 142 159 #include "../kernels_unst/compute_geopot.k90" 143 160 STOP_TRACE 144 END SUBROUTINE compute_geopot_unst 161 END SUBROUTINE compute_geopot_unst_ 145 162 146 SUBROUTINE compute_geopot_hex (rhodz,theta, ps,pk,geopot)163 SUBROUTINE compute_geopot_hex_(rhodz,theta, ps,pk,geopot) 147 164 REAL(rstd),INTENT(IN) :: rhodz(iim*jjm,llm) 148 165 REAL(rstd),INTENT(IN) :: theta(iim*jjm,llm,nqdyn) ! active scalars : theta/entropy, moisture, ... … … 162 179 163 180 CALL trace_end("compute_geopot") 164 END SUBROUTINE compute_geopot_hex 181 END SUBROUTINE compute_geopot_hex_ 165 182 166 183 SUBROUTINE compute_geopot_manual(rhodz,theta, ps,pk,geopot) -
codes/icosagcm/devel/src/dynamics/compute_pvort_only.F90
r939 r1027 1 1 MODULE compute_pvort_only_mod 2 2 USE grid_param 3 USE prec, ONLY : rstd 3 4 IMPLICIT NONE 4 5 PRIVATE … … 36 37 #endif END_DYSL 37 38 38 SUBROUTINE compute_pvort_only_unst(u,rhodz,qu,qv, hv_) 39 !-------------- Wrappers for F2008 conformity ----------------- 40 41 SUBROUTINE compute_pvort_only_unst(u,rhodz,qu,qv,hv_) 42 REAL(rstd),INTENT(IN) :: u(:,:) 43 REAL(rstd),INTENT(INOUT) :: rhodz(:,:) 44 REAL(rstd),INTENT(OUT) :: qu(:,:), qv(:,:), hv_(:,:) 45 CALL compute_pvort_only_unst_(u,rhodz,qu,qv,hv_) 46 END SUBROUTINE compute_pvort_only_unst 47 48 SUBROUTINE compute_pvort_only_hex(u,rhodz,qu,qv,hv_) 49 REAL(rstd),INTENT(IN) :: u(:,:) 50 REAL(rstd),INTENT(INOUT) :: rhodz(:,:) 51 REAL(rstd),INTENT(OUT) :: qu(:,:), qv(:,:), hv_(:,:) 52 CALL compute_pvort_only_hex_(u,rhodz,qu,qv,hv_) 53 END SUBROUTINE compute_pvort_only_hex 54 55 !-------------------------------------------------------------- 56 57 SUBROUTINE compute_pvort_only_unst_(u,rhodz,qu,qv, hv_) 39 58 USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT 40 59 USE geometry, ONLY : Riv2, Av, fv … … 51 70 #include "../kernels_unst/pvort_only.k90" 52 71 STOP_TRACE 53 END SUBROUTINE compute_pvort_only_unst 72 END SUBROUTINE compute_pvort_only_unst_ 54 73 55 SUBROUTINE compute_pvort_only_hex (u,rhodz,qu,qv,hv_)74 SUBROUTINE compute_pvort_only_hex_(u,rhodz,qu,qv,hv_) 56 75 USE icosa 57 76 USE trace, ONLY : trace_start, trace_end … … 108 127 CALL trace_end("compute_pvort_only") 109 128 110 END SUBROUTINE compute_pvort_only_hex 129 END SUBROUTINE compute_pvort_only_hex_ 111 130 112 131 END MODULE compute_pvort_only_mod -
codes/icosagcm/devel/src/dynamics/compute_theta.F90
r939 r1027 1 1 MODULE compute_theta_mod 2 USE prec, ONLY : rstd 2 3 USE grid_param 3 4 USE disvert_mod, ONLY : mass_dak, mass_dbk, caldyn_eta, eta_mass, ptop … … 71 72 #endif END_DYSL 72 73 73 SUBROUTINE compute_theta_unst(mass_col,theta_rhodz, rhodz,theta) 74 !-------------- Wrappers for F2008 conformity ----------------- 75 76 SUBROUTINE compute_theta_unst(ps,theta_rhodz, rhodz,theta) 77 REAL(rstd),INTENT(IN) :: ps(:), theta_rhodz(:,:,:) 78 REAL(rstd),INTENT(INOUT) :: rhodz(:,:) 79 REAL(rstd),INTENT(OUT) :: theta(:,:,:) 80 CALL compute_theta_unst_(ps,theta_rhodz, rhodz,theta) 81 END SUBROUTINE compute_theta_unst 82 83 SUBROUTINE compute_theta_hex(ps,theta_rhodz, rhodz,theta) 84 REAL(rstd),INTENT(IN) :: ps(:), theta_rhodz(:,:,:) 85 REAL(rstd),INTENT(INOUT) :: rhodz(:,:) 86 REAL(rstd),INTENT(OUT) :: theta(:,:,:) 87 CALL compute_theta_hex_(ps,theta_rhodz, rhodz,theta) 88 END SUBROUTINE compute_theta_hex 89 90 !-------------------------------------------------------------- 91 92 SUBROUTINE compute_theta_unst_(mass_col,theta_rhodz, rhodz,theta) 74 93 USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT 75 94 USE data_unstructured_mod, ONLY : enter_trace, exit_trace, id_theta … … 86 105 #undef MASS_DBK 87 106 STOP_TRACE 88 END SUBROUTINE compute_theta_unst 107 END SUBROUTINE compute_theta_unst_ 89 108 90 SUBROUTINE compute_theta_hex (mass_col,theta_rhodz, rhodz,theta)109 SUBROUTINE compute_theta_hex_(mass_col,theta_rhodz, rhodz,theta) 91 110 USE icosa 92 111 USE trace, ONLY : trace_start, trace_end … … 105 124 #undef MASS_DBK 106 125 CALL trace_end("compute_theta") 107 END SUBROUTINE compute_theta_hex 126 END SUBROUTINE compute_theta_hex_ 108 127 109 128 SUBROUTINE compute_theta_manual(ps,theta_rhodz, rhodz,theta) -
codes/icosagcm/devel/src/vertical/vertical_interp.f90
r958 r1027 42 42 END SUBROUTINE vertical_interp 43 43 44 !-------------- Wrappers for F2008 conformity ----------------- 45 44 46 SUBROUTINE compute_vertical_interp_hex(pmid,in,out,pval) 47 REAL(rstd),INTENT(IN) :: pmid(:,:), in(:,:), pval 48 REAL(rstd),INTENT(OUT):: out(:) 49 CALL compute_vertical_interp_hex_(pmid,in,out,pval) 50 END SUBROUTINE compute_vertical_interp_hex 51 52 SUBROUTINE compute_vertical_interp_unst(pmid,in,out,pval) 53 REAL(rstd),INTENT(IN) :: pmid(:,:), in(:,:), pval 54 REAL(rstd),INTENT(OUT):: out(:) 55 CALL compute_vertical_interp_unst_(pmid,in,out,pval) 56 END SUBROUTINE compute_vertical_interp_unst 57 58 !-------------------------------------------------------------- 59 60 SUBROUTINE compute_vertical_interp_hex_(pmid,in,out,pval) 45 61 REAL(rstd),INTENT(IN) :: pmid(iim*jjm,llm) 46 62 REAL(rstd),INTENT(IN) :: in(iim*jjm,llm) … … 61 77 !$OMP BARRIER 62 78 63 END SUBROUTINE compute_vertical_interp_hex 79 END SUBROUTINE compute_vertical_interp_hex_ 64 80 65 SUBROUTINE compute_vertical_interp_unst (pmid,in,out,pval)81 SUBROUTINE compute_vertical_interp_unst_(pmid,in,out,pval) 66 82 REAL(rstd),INTENT(IN) :: pmid(llm, primal_num) 67 83 REAL(rstd),INTENT(IN) :: in(llm, primal_num) … … 76 92 !$OMP END MASTER 77 93 !$OMP BARRIER 78 END SUBROUTINE compute_vertical_interp_unst 94 END SUBROUTINE compute_vertical_interp_unst_ 79 95 80 96 PURE SUBROUTINE interp_1d(pmid,in,out,pval)
Note: See TracChangeset
for help on using the changeset viewer.