Changeset 160 for codes/icosagcm/trunk
- Timestamp:
- 06/27/13 15:50:24 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/check_conserve.f90
r151 r160 10 10 PUBLIC init_check_conserve, check_conserve 11 11 REAL(rstd),SAVE:: mtot0,ztot0,etot0,ang0,stot0,rmsv0 12 REAL(rstd),SAVE:: rmsdpdt,etot,ang,stot,rmsv13 REAL(rstd),SAVE:: ztot ,mtot12 REAL(rstd),SAVE:: etot,ang,stot,rmsv 13 REAL(rstd),SAVE:: ztot 14 14 15 15 … … 34 34 USE caldyn_gcm_mod 35 35 USE exner_mod 36 USE mpipara 36 USE mpipara, ONLY : is_mpi_root, comm_icosa 37 37 IMPLICIT NONE 38 38 TYPE(t_field),POINTER :: f_ps(:) … … 41 41 TYPE(t_field),POINTER :: f_theta_rhodz(:) 42 42 TYPE(t_field),POINTER :: f_phis(:) 43 INTEGER::it 43 INTEGER::it 44 44 45 REAL(rstd),POINTER :: p(:,:),rhodz(:,:) 45 INTEGER::ind 46 INTEGER::ind,ierr 47 REAL(rstd) :: mtot, rmsdpdt 46 48 47 49 etot=0.0; ang=0.0;stot=0.0;rmsv=0.0 48 mtot=0.0 ; rmsdpdt=0.0 ;ztot = 0.050 ztot = 0.0 49 51 50 52 CALL pression(f_ps,f_p) … … 53 55 CALL swap_dimensions(ind) 54 56 CALL swap_geometry(ind) 55 56 57 p=f_p(ind) 58 rhodz=f_rhodz(ind) 57 59 CALL compute_rhodz(p,rhodz) 58 END DO 60 END DO 59 61 60 62 CALL vorticity(f_ue,f_vort) 61 CALL check_mass_conserve(f_ps,f_dps )63 CALL check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt) 62 64 CALL check_PV 63 65 CALL exner(f_ps,f_p,f_pks,f_pk) 64 66 CALL check_EN(f_ue,f_theta_rhodz,f_phis) 67 68 IF (is_mpi_root) THEN 65 69 66 IF ( it == 0 ) Then 67 ztot0 = ztot 68 mtot0 = mtot 69 etot0 = etot 70 ang0 = ang 71 stot0 = stot 72 END IF 73 74 rmsv=SQRT(rmsv/mtot) 75 ztot=ztot/ztot0 ; mtot=mtot/mtot0 76 etot=etot/etot0 ; ang=ang/ang0 ; stot=stot/stot0 77 rmsdpdt= daysec*1.e-2*sqrt(rmsdpdt/ncell_glo) 78 79 80 IF (is_mpi_root) THEN 70 IF ( it == 0 ) Then 71 ztot0 = ztot 72 mtot0 = mtot 73 etot0 = etot 74 ang0 = ang 75 stot0 = stot 76 END IF 77 78 rmsv=SQRT(rmsv/mtot) 79 ztot=ztot/ztot0-1. ; mtot=mtot/mtot0-1. 80 etot=etot/etot0-1. ; ang=ang/ang0-1. ; stot=stot/stot0-1. 81 rmsdpdt= daysec*1.e-2*sqrt(rmsdpdt/ncell_glo) 82 81 83 OPEN(134,file="checkconsicosa.txt",position='append') 82 84 WRITE(134,4000)mtot,rmsdpdt,etot,ztot,stot,rmsv,ang … … 84 86 WRITE(134,*)"==================================================" 85 87 WRITE(*,4000)mtot,rmsdpdt,etot,ztot,stot,rmsv,ang 86 88 87 89 4000 FORMAT(10x,'masse',4x,'rmsdpdt',7x,'energie',2x,'enstrophie' & 88 ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB ' &89 ,f10.6,e13.6,5f10.3/)90 ,2x,'entropie',3x,'rmsv',4x,'mt.ang',/,'GLOB ' & 91 ,e10.3,e13.6,5e10.3/) 90 92 close(134) 91 END IF93 END IF 92 94 END SUBROUTINE check_conserve 93 95 94 96 !--------------------------------------------------------------------- 95 97 96 SUBROUTINE check_mass_conserve(f_ps,f_dps) 98 SUBROUTINE check_mass_conserve(f_ps,f_dps,mtot,rmsdpdt) 99 USE mpi_mod 100 USE mpipara 97 101 USE icosa 98 102 IMPLICIT NONE … … 100 104 TYPE(t_field),POINTER :: f_dps(:) 101 105 REAL(rstd),POINTER :: ps(:),dps(:) 106 REAL(rstd), INTENT(OUT) :: mtot, rmsdpdt 107 102 108 INTEGER :: ind,i,j,ij 103 109 REAL :: mloc, rmsloc 110 111 mloc=0.0; rmsloc=0.0 104 112 DO ind=1,ndomain 105 113 CALL swap_dimensions(ind) … … 111 119 ij=(j-1)*iim+i 112 120 IF (domain(ind)%own(i,j)) THEN 113 mtot=mtot+ps(ij)*Ai(ij)114 rmsdpdt=rmsdpdt+dps(ij)*dps(ij)121 mloc=mloc+ps(ij)*Ai(ij) 122 rmsloc=rmsloc+dps(ij)*dps(ij) 115 123 ENDIF 116 124 ENDDO 117 125 ENDDO 118 126 ENDDO 127 128 CALL MPI_REDUCE(mloc, mtot, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr) 129 CALL MPI_REDUCE(rmsloc, rmsdpdt, 1, MPI_REAL8, MPI_SUM, 0, comm_icosa, ierr) 130 119 131 END SUBROUTINE check_mass_conserve 120 132
Note: See TracChangeset
for help on using the changeset viewer.