[348] | 1 | MODULE physics_external_mod |
---|
| 2 | USE field_mod |
---|
| 3 | |
---|
| 4 | INTEGER,SAVE :: it |
---|
| 5 | !$OMP THREADPRIVATE(it) |
---|
| 6 | |
---|
| 7 | TYPE(t_field),POINTER,SAVE :: f_phis(:) |
---|
| 8 | TYPE(t_field),POINTER,SAVE :: f_ps(:) |
---|
| 9 | TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:) |
---|
| 10 | TYPE(t_field),POINTER,SAVE :: f_u(:) |
---|
| 11 | TYPE(t_field),POINTER,SAVE :: f_wflux(:) |
---|
| 12 | TYPE(t_field),POINTER,SAVE :: f_q(:) |
---|
[871] | 13 | |
---|
| 14 | TYPE(t_field),POINTER,SAVE :: f_theta_rhodz0(:) |
---|
| 15 | TYPE(t_field),POINTER,SAVE :: f_u0(:) |
---|
| 16 | TYPE(t_field),POINTER,SAVE :: f_q0(:) |
---|
| 17 | |
---|
| 18 | TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz(:) |
---|
| 19 | TYPE(t_field),POINTER,SAVE :: f_du(:) |
---|
| 20 | TYPE(t_field),POINTER,SAVE :: f_dq(:) |
---|
| 21 | |
---|
| 22 | TYPE(t_field),POINTER,SAVE :: f_rhodz(:) |
---|
| 23 | TYPE(t_field),POINTER,SAVE :: f_rhodz0(:) |
---|
[348] | 24 | |
---|
[871] | 25 | LOGICAL,SAVE :: phys_smooth_tendency |
---|
| 26 | !$OMP THREADPRIVATE(phys_smooth_tendency) |
---|
| 27 | |
---|
| 28 | |
---|
[348] | 29 | CONTAINS |
---|
| 30 | |
---|
| 31 | SUBROUTINE init_physics |
---|
[871] | 32 | USE icosa |
---|
| 33 | IMPLICIT NONE |
---|
[348] | 34 | |
---|
| 35 | CALL initialize_external_physics |
---|
[889] | 36 | !$OMP PARALLEL |
---|
[871] | 37 | CALL allocate_field(f_theta_rhodz0, field_t, type_real, llm, nqdyn, name='theta_rhodz0') |
---|
| 38 | CALL allocate_field(f_u0,field_u,type_real,llm,name='u0') |
---|
| 39 | CALL allocate_field(f_q0,field_t,type_real,llm,nqtot,'q0') |
---|
| 40 | |
---|
| 41 | CALL allocate_field(f_dtheta_rhodz, field_t, type_real, llm, nqdyn, name='theta_rhodz0') |
---|
| 42 | CALL allocate_field(f_du,field_u,type_real,llm,name='u0') |
---|
| 43 | CALL allocate_field(f_dq,field_t,type_real,llm,nqtot,'q0') |
---|
| 44 | |
---|
| 45 | CALL allocate_field(f_rhodz, field_t, type_real, llm, name='rhodz') |
---|
| 46 | |
---|
| 47 | phys_smooth_tendency=.FALSE. |
---|
| 48 | CALL getin("phys_smooth_tendency",phys_smooth_tendency) |
---|
[889] | 49 | !$OMP END PARALLEL |
---|
[348] | 50 | |
---|
| 51 | END SUBROUTINE init_physics |
---|
| 52 | |
---|
| 53 | SUBROUTINE physics(it_,f_phis_, f_ps_, f_theta_rhodz_, f_u_, f_wflux_, f_q_) |
---|
[871] | 54 | USE icosa |
---|
[348] | 55 | USE field_mod |
---|
[871] | 56 | USE mpipara |
---|
| 57 | USE omp_para |
---|
[904] | 58 | !USE xios |
---|
[871] | 59 | USE domain_mod |
---|
| 60 | USE time_mod |
---|
| 61 | USE disvert_mod |
---|
[348] | 62 | IMPLICIT NONE |
---|
| 63 | INTEGER,INTENT(IN) :: it_ |
---|
| 64 | TYPE(t_field),POINTER :: f_phis_(:) |
---|
| 65 | TYPE(t_field),POINTER :: f_ps_(:) |
---|
| 66 | TYPE(t_field),POINTER :: f_theta_rhodz_(:) |
---|
| 67 | TYPE(t_field),POINTER :: f_u_(:) |
---|
| 68 | TYPE(t_field),POINTER :: f_wflux_(:) |
---|
| 69 | TYPE(t_field),POINTER :: f_q_(:) |
---|
| 70 | |
---|
[871] | 71 | REAL(rstd),POINTER :: theta_rhodz(:,:,:), theta_rhodz0(:,:,:), dtheta_rhodz(:,:,:) |
---|
| 72 | REAL(rstd),POINTER :: u(:,:), u0(:,:), du(:,:) |
---|
| 73 | REAL(rstd),POINTER :: q(:,:,:),q0(:,:,:),dq(:,:,:) |
---|
| 74 | REAL(rstd),POINTER :: ps(:) |
---|
| 75 | REAL(rstd),POINTER :: rhodz(:,:) |
---|
| 76 | INTEGER :: ind, iq |
---|
[348] | 77 | |
---|
[871] | 78 | |
---|
[348] | 79 | !$OMP BARRIER |
---|
| 80 | !$OMP MASTER |
---|
| 81 | f_phis=>f_phis_ |
---|
| 82 | f_ps=>f_ps_ |
---|
| 83 | f_theta_rhodz=>f_theta_rhodz_ |
---|
| 84 | f_u=>f_u_ |
---|
| 85 | f_wflux=>f_wflux_ |
---|
| 86 | f_q=>f_q_ |
---|
| 87 | !$OMP END MASTER |
---|
| 88 | !$OMP BARRIER |
---|
| 89 | |
---|
[871] | 90 | IF (phys_smooth_tendency) THEN |
---|
[889] | 91 | |
---|
[871] | 92 | IF (MOD(it_,itau_physics)==1) THEN |
---|
| 93 | DO ind=1, ndomain |
---|
| 94 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 95 | CALL swap_dimensions(ind) |
---|
| 96 | CALL swap_geometry(ind) |
---|
| 97 | theta_rhodz=f_theta_rhodz(ind) |
---|
| 98 | theta_rhodz0=f_theta_rhodz0(ind) |
---|
| 99 | u=f_u(ind) |
---|
| 100 | u0=f_u0(ind) |
---|
| 101 | q=f_q(ind) |
---|
| 102 | q0=f_q0(ind) |
---|
| 103 | ps=f_ps(ind) |
---|
| 104 | rhodz=f_rhodz(ind) |
---|
| 105 | |
---|
[889] | 106 | theta_rhodz0(:,ll_begin:ll_end,1)=theta_rhodz(:,ll_begin:ll_end,1) |
---|
| 107 | u0(:,ll_begin:ll_end)=u(:,ll_begin:ll_end) |
---|
| 108 | q0(:,ll_begin:ll_end,:)=q(:,ll_begin:ll_end,:) |
---|
[871] | 109 | CALL compute_rhodz(.TRUE., ps, rhodz) |
---|
| 110 | ENDDO |
---|
| 111 | |
---|
[872] | 112 | ! IF (is_omp_master) CALL xios_timer_suspend("dynamico") |
---|
[871] | 113 | it = it_-1 + itau_physics |
---|
| 114 | CALL external_physics |
---|
[872] | 115 | ! IF (is_omp_master) CALL xios_timer_resume("dynamico") |
---|
[871] | 116 | |
---|
| 117 | DO ind=1, ndomain |
---|
| 118 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 119 | CALL swap_dimensions(ind) |
---|
| 120 | CALL swap_geometry(ind) |
---|
| 121 | theta_rhodz=f_theta_rhodz(ind) |
---|
| 122 | theta_rhodz0=f_theta_rhodz0(ind) |
---|
| 123 | u=f_u(ind) |
---|
| 124 | u0=f_u0(ind) |
---|
| 125 | q=f_q(ind) |
---|
| 126 | q0=f_q0(ind) |
---|
| 127 | dtheta_rhodz=f_dtheta_rhodz(ind) |
---|
| 128 | du=f_du(ind) |
---|
| 129 | dq=f_dq(ind) |
---|
| 130 | rhodz=f_rhodz(ind) |
---|
| 131 | |
---|
[889] | 132 | dtheta_rhodz(:,ll_begin:ll_end,1)=(theta_rhodz(:,ll_begin:ll_end,1)-theta_rhodz0(:,ll_begin:ll_end,1))/itau_physics |
---|
| 133 | |
---|
| 134 | du(:,ll_begin:ll_end)=(u(:,ll_begin:ll_end)-u0(:,ll_begin:ll_end))/itau_physics |
---|
| 135 | |
---|
[871] | 136 | DO iq=1, nqtot |
---|
[889] | 137 | dq(:,ll_begin:ll_end,iq)=((q(:,ll_begin:ll_end,iq)-q0(:,ll_begin:ll_end,iq))/itau_physics)*rhodz(:,ll_begin:ll_end) |
---|
[871] | 138 | ENDDO |
---|
| 139 | |
---|
[889] | 140 | theta_rhodz(:,ll_begin:ll_end,1)=theta_rhodz0(:,ll_begin:ll_end,1) |
---|
| 141 | u(:,ll_begin:ll_end)=u0(:,ll_begin:ll_end) |
---|
| 142 | q(:,ll_begin:ll_end,:)=q0(:,ll_begin:ll_end,:) |
---|
[871] | 143 | ENDDO |
---|
| 144 | ENDIF |
---|
| 145 | |
---|
| 146 | DO ind=1, ndomain |
---|
| 147 | IF (.NOT. assigned_domain(ind)) CYCLE |
---|
| 148 | CALL swap_dimensions(ind) |
---|
| 149 | CALL swap_geometry(ind) |
---|
| 150 | |
---|
| 151 | theta_rhodz=f_theta_rhodz(ind) |
---|
| 152 | u=f_u(ind) |
---|
| 153 | q=f_q(ind) |
---|
| 154 | dtheta_rhodz=f_dtheta_rhodz(ind) |
---|
| 155 | du=f_du(ind) |
---|
| 156 | dq=f_dq(ind) |
---|
| 157 | rhodz=f_rhodz(ind) |
---|
| 158 | ps=f_ps(ind) |
---|
| 159 | |
---|
[889] | 160 | u(:,ll_begin:ll_end)=u(:,ll_begin:ll_end)+du(:,ll_begin:ll_end) |
---|
| 161 | theta_rhodz(:,ll_begin:ll_end,1)=theta_rhodz(:,ll_begin:ll_end,1)+dtheta_rhodz(:,ll_begin:ll_end,1) |
---|
[871] | 162 | CALL compute_rhodz(.TRUE., ps, rhodz) |
---|
| 163 | DO iq=1, nqtot |
---|
[889] | 164 | q(:,ll_begin:ll_end,iq)=q(:,ll_begin:ll_end,iq)+dq(:,ll_begin:ll_end,iq)/rhodz(:,ll_begin:ll_end) |
---|
[871] | 165 | ENDDO |
---|
| 166 | ENDDO |
---|
[889] | 167 | !$OMP BARRIER |
---|
[871] | 168 | |
---|
| 169 | ELSE |
---|
| 170 | |
---|
| 171 | IF (MOD(it_,itau_physics)==0) THEN |
---|
| 172 | it=it_ |
---|
[872] | 173 | ! IF (is_omp_master) CALL xios_timer_suspend("dynamico") |
---|
[871] | 174 | CALL external_physics |
---|
[872] | 175 | ! IF (is_omp_master) CALL xios_timer_resume("dynamico") |
---|
[871] | 176 | ENDIF |
---|
| 177 | |
---|
| 178 | ENDIF |
---|
| 179 | |
---|
| 180 | |
---|
[348] | 181 | END SUBROUTINE physics |
---|
| 182 | |
---|
| 183 | |
---|
| 184 | END MODULE physics_external_mod |
---|
| 185 | |
---|
| 186 | |
---|