Changeset 1046 for codes/icosagcm/trunk/src
- Timestamp:
- 08/20/20 16:22:41 (4 years ago)
- Location:
- codes/icosagcm/trunk/src
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/diagnostics/geopotential_mod.f90
r899 r1046 28 28 theta_rhodz = f_theta_rhodz(ind) 29 29 theta = f_theta(ind) 30 CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0 )30 CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0, ondevice=.FALSE.) 31 31 phis = f_phis(ind) 32 32 phi = f_phi(ind) -
codes/icosagcm/trunk/src/diagnostics/theta_rhodz.f90
r548 r1046 39 39 theta_rhodz=f_theta_rhodz(ind) 40 40 theta=f_theta(ind) 41 CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0 )41 CALL compute_theta_rhodz2theta(ps, theta_rhodz,theta,0, ondevice=.false.) 42 42 ENDDO 43 43 !$OMP BARRIER … … 132 132 theta=f_theta(ind) 133 133 theta_rhodz=f_theta_rhodz(ind) 134 CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0 )134 CALL compute_theta2theta_rhodz(ps, theta, theta_rhodz,0,ondevice=.false.) 135 135 ENDDO 136 136 !$OMP BARRIER … … 138 138 END SUBROUTINE theta2theta_rhodz 139 139 140 SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset )140 SUBROUTINE compute_theta2theta_rhodz(ps,theta, theta_rhodz,offset, ondevice) 141 141 USE icosa 142 142 USE disvert_mod … … 147 147 REAL(rstd),INTENT(OUT) :: theta_rhodz(iim*jjm,llm) 148 148 INTEGER,INTENT(IN) :: offset 149 LOGICAL, INTENT(IN) :: ondevice 149 150 REAL(rstd) :: rhodz 150 151 INTEGER :: i,j,ij,l 151 152 152 153 !$OMP BARRIER 154 !$acc parallel loop collapse(3) default(present) async if(ondevice) 153 155 DO l = ll_begin, ll_end 154 156 DO j=jj_begin-offset,jj_end+offset … … 165 167 END SUBROUTINE compute_theta2theta_rhodz 166 168 167 SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset )169 SUBROUTINE compute_theta_rhodz2theta(ps,theta_rhodz,theta,offset,ondevice) 168 170 USE icosa 169 171 USE disvert_mod … … 174 176 REAL(rstd),INTENT(OUT) :: theta(iim*jjm,llm) 175 177 INTEGER,INTENT(IN) :: offset 178 LOGICAL, INTENT(IN) :: ondevice 176 179 REAL(rstd) :: rhodz 177 180 INTEGER :: i,j,ij,l 178 181 179 182 !$OMP BARRIER 183 !$acc parallel loop collapse(3) default(present) async if(ondevice) 180 184 DO l = ll_begin, ll_end 181 185 DO j=jj_begin-offset,jj_end+offset -
codes/icosagcm/trunk/src/initial/etat0_academic.f90
r899 r1046 228 228 ENDDO 229 229 230 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1 )230 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1, ondevice=.false.) 231 231 232 232 -
codes/icosagcm/trunk/src/initial/etat0_heldsz.f90
r970 r1046 89 89 theta=f_theta(ind) 90 90 CALL compute_etat0_heldsz(theta_eq,theta) 91 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz(:,:,1),1 )91 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz(:,:,1),1, ondevice=.false.) 92 92 IF(nqtot>0) THEN 93 93 q=f_q(ind) … … 96 96 IF(nqtot>2) q(:,:,3:)=0. 97 97 END IF 98 99 call update_device_field(f_theta_eq) 100 call update_device_field(f_theta) 101 !$acc enter data copyin(knewt_t(:)) async 102 !$acc enter data copyin(kfrict(:)) async 103 98 104 ENDDO 99 105 END SUBROUTINE etat0 … … 236 242 INTEGER :: i,j,l,ij 237 243 238 CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1 )244 CALL compute_theta_rhodz2theta(ps,theta_rhodz,theta,1, ondevice=.TRUE.) 239 245 DO l=ll_begin,ll_end 240 246 DO j=jj_begin-1,jj_end+1 … … 246 252 ENDDO 247 253 ENDDO 248 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1) 249 250 Do l=ll_begin,ll_end 254 CALL compute_theta2theta_rhodz(ps,theta,theta_rhodz,1, ondevice=.true.) 255 256 !$acc kernels default(present) async 257 DO l=ll_begin,ll_end 251 258 u(:,l)=u(:,l)*(1.-itau_physics*dt*kfrict(l)) 252 259 END DO 260 !$acc end kernels 253 261 254 262 END SUBROUTINE compute_heldsz -
codes/icosagcm/trunk/src/physics/physics.f90
r953 r1046 113 113 114 114 !$OMP PARALLEL 115 CALL allocate_field(f_du_phys,field_u,type_real,llm, name='du_phys' )115 CALL allocate_field(f_du_phys,field_u,type_real,llm, name='du_phys', ondevice=.TRUE.) 116 116 117 117 IF(is_mpi_root) PRINT *, 'phys_type = ',phys_type … … 119 119 120 120 !$OMP END PARALLEL 121 IF (phys_type /= phys_none ) THEN122 CALL abort_acc(" physics /= 'none'")121 IF (phys_type /= phys_none .AND. phys_type /= phys_HS94) THEN 122 CALL abort_acc("only phys_type == 'phys_none' or 'phys_HS94' supported") 123 123 END IF 124 124 END SUBROUTINE init_physics … … 133 133 CALL swap_geometry(ind) 134 134 du=f_du_phys(ind) 135 136 !$acc kernels default(present) async 135 137 du(:,ll_begin:ll_end) = 0. 138 !$acc end kernels 139 136 140 END DO 137 141 END SUBROUTINE zero_du_phys … … 141 145 TYPE(t_field),POINTER :: f_u(:) ! velocity field before/after call to physics 142 146 REAL(rstd), DIMENSION(:,:), POINTER :: u, du 143 INTEGER :: ind 147 INTEGER :: ind, ij 148 144 149 DO ind=1,ndomain 145 150 IF (.NOT. assigned_domain(ind)) CYCLE … … 148 153 du=f_du_phys(ind) 149 154 u=f_u(ind) 150 du(:,ll_begin:ll_end) = du(:,ll_begin:ll_end) + coef*u(:,ll_begin:ll_end) 155 156 !$acc parallel loop default(present) async 157 DO ij = ij_begin, ij_end 158 du(ij,ll_begin:ll_end) = du(ij,ll_begin:ll_end) + coef*u(ij,ll_begin:ll_end) 159 END DO 160 151 161 END DO 152 162 END SUBROUTINE add_du_phys … … 228 238 USE wind_mod 229 239 USE output_field_mod 230 CALL transfert_request(f_du_phys,req_e1_vect) 240 241 CALL transfert_request(f_du_phys,req_e1_vect) 242 CALL update_host_field(f_du_phys) 243 231 244 CALL un2ulonlat(f_du_phys, f_buf_ulon, f_buf_ulat, (1./(dt*itau_out))) 232 245 CALL output_field("dulon_phys",f_buf_ulon)
Note: See TracChangeset
for help on using the changeset viewer.