Changeset 902 for codes/icosagcm/trunk/src/diagnostics
- Timestamp:
- 06/13/19 16:45:43 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/diagnostics/check_conserve.f90
r899 r902 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,stot019 REAL(rstd),SAVE :: mtot0,mqtot0,ztot0,etot0,angtot0,stot0 20 20 !$OMP THREADPRIVATE(check_type, mtot0,ztot0,etot0,angtot0,stot0) 21 21 … … 51 51 !--------------------------------- Basic check -------------------------------- 52 52 53 SUBROUTINE check_conserve(f_ps,f_dps,f_ue,f_theta_rhodz,f_phis, it)53 SUBROUTINE check_conserve(f_ps,f_dps,f_ue,f_theta_rhodz,f_phis,f_q,it) 54 54 USE pression_mod 55 55 USE vorticity_mod … … 63 63 TYPE(t_field),POINTER :: f_theta_rhodz(:) 64 64 TYPE(t_field),POINTER :: f_phis(:) 65 TYPE(t_field),POINTER :: f_q(:) 65 66 INTEGER, INTENT(IN) :: it 66 67 67 68 REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 68 69 INTEGER :: ind 69 REAL(rstd) :: mtot, angtot, rmsdpdt70 REAL(rstd) :: mtot, mqtot, angtot, rmsdpdt 70 71 REAL(rstd) :: etot, stot, ang_mass, ang_vel, ang_velp, ang_velm, rmsvtot, ztot 71 72 … … 83 84 84 85 CALL vorticity(f_ue,f_vort) 86 CALL check_qmass_conserve(f_q,f_rhodz,mqtot) 85 87 CALL check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt) 86 88 CALL check_PV(ztot) … … 98 100 ztot0 = ztot 99 101 mtot0 = mtot 102 mqtot0 = mqtot 100 103 etot0 = etot 101 104 angtot0 = angtot … … 111 114 END IF 112 115 rmsvtot=SQRT(rmsvtot/mtot) 113 ztot=ztot/ztot0-1. ; mtot=mtot/mtot0-1. 116 ztot=ztot/ztot0-1. ; mtot=mtot/mtot0-1. 117 mqtot=(mqtot+1E-100)/(mqtot0+1e-100)-1. 114 118 etot=etot/etot0-1. ; angtot=angtot/angtot0-1. ; stot=stot/stot0-1. 115 119 rmsdpdt= daysec*1.e-2*sqrt(rmsdpdt/ncell_glo) 116 120 117 121 OPEN(134,file="checkconsicosa.txt",position='append') 118 WRITE(134,4000)mtot, rmsdpdt,etot,ztot,stot,rmsvtot,angtot119 WRITE(134,*)mtot, rmsdpdt,etot,ztot,stot,rmsvtot,angtot122 WRITE(134,4000)mtot,mqtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot 123 WRITE(134,*)mtot,mqtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot 120 124 WRITE(134,*)"==================================================" 121 WRITE(*,4000)mtot, rmsdpdt,etot,ztot,stot,rmsvtot,angtot125 WRITE(*,4000)mtot,mqtot,rmsdpdt,etot,ztot,stot,rmsvtot,angtot 122 126 123 4000 FORMAT(10x,'masse',5x,' rmsdpdt',5x,'energie',5x,'enstrophie' &127 4000 FORMAT(10x,'masse',5x,'advec mass',5x,'rmsdpdt',6x,'energie',3x,'enstrophie' & 124 128 ,5x,'entropie',5x,'rmsv',5x,'mt.ang',/,'GLOB ' & 125 , e10.3,e13.6,5e13.3/)129 ,2e10.3,e13.5,5e13.3/) 126 130 CLOSE(134) 127 131 … … 269 273 END SUBROUTINE check_mass_conserve 270 274 275 SUBROUTINE check_qmass_conserve(f_q,f_rhodz,mqtot) 276 USE mpi_mod 277 USE mpipara 278 USE transfert_omp_mod 279 USE omp_para 280 IMPLICIT NONE 281 TYPE(t_field),POINTER :: f_q(:) 282 TYPE(t_field),POINTER :: f_rhodz(:) 283 REAL(rstd),POINTER :: q(:,:,:) 284 REAL(rstd),POINTER :: rhodz(:,:) 285 REAL(rstd), INTENT(OUT) :: mqtot 286 287 INTEGER :: ind,i,j,ij,l 288 REAL :: mloc 289 290 mloc=0.0 291 DO ind=1,ndomain 292 IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 293 CALL swap_dimensions(ind) 294 CALL swap_geometry(ind) 295 q=f_q(ind) 296 rhodz=f_rhodz(ind) 297 DO j=jj_begin,jj_end 298 DO i=ii_begin,ii_end 299 ij=(j-1)*iim+i 300 IF (domain(ind)%own(i,j)) THEN 301 DO l=1, llm 302 mloc=mloc + sum( q(ij,l,:)*Ai(ij)*rhodz(ij,l) ) 303 END DO 304 ENDIF 305 ENDDO 306 ENDDO 307 ENDDO 308 309 CALL global_sum(mloc, mqtot) 310 END SUBROUTINE check_qmass_conserve 311 271 312 !--------------------------------------------------------------------- 272 313
Note: See TracChangeset
for help on using the changeset viewer.