Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r1948 r2528 4 4 !! AR5 diagnostics 5 5 !!====================================================================== 6 !! History : 3.2 ! 2009-11 (S. Masson) Original code 6 !! History : 3.2 ! 2009-11 (S. Masson) Original code 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_diaar5 … … 10 11 !! 'key_diaar5' : activate ar5 diagnotics 11 12 !!---------------------------------------------------------------------- 12 !! exa_mpl : liste of module subroutine (caution, never use the 13 !! exa_mpl_init : name of the module for a routine) 14 !! exa_mpl_stp : Please try to use 3 letter block for routine names 13 !! dia_ar5 : AR5 diagnostics 14 !! dia_ar5_init : initialisation of AR5 diagnostics 15 15 !!---------------------------------------------------------------------- 16 16 USE oce ! ocean dynamics and active tracers 17 17 USE dom_oce ! ocean space and time domain 18 USE eosbn2 18 USE eosbn2 ! equation of state (eos_bn2 routine) 19 19 USE lib_mpp ! distribued memory computing library 20 20 USE iom ! I/O manager library … … 23 23 PRIVATE 24 24 25 PUBLIC dia_ar5 ! routine called in step.F90 module 25 PUBLIC dia_ar5 ! routine called in step.F90 module 26 PUBLIC dia_ar5_init ! routine called in opa.F90 module 26 27 27 28 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE. ! coupled flag 28 29 29 REAL(wp) :: vol0 30 REAL(wp) :: area_tot 31 REAL(wp), DIMENSION(jpi,jpj ) :: area 32 REAL(wp), DIMENSION(jpi,jpj ) :: thick0 33 REAL(wp), DIMENSION(jpi,jpj,jpk) :: sn0 30 REAL(wp) :: vol0 ! ocean volume (interior domain) 31 REAL(wp) :: area_tot ! total ocean surface (interior domain) 32 REAL(wp), DIMENSION(jpi,jpj ) :: area ! cell surface (interior domain) 33 REAL(wp), DIMENSION(jpi,jpj ) :: thick0 ! ocean thickness (interior domain) 34 REAL(wp), DIMENSION(jpi,jpj,jpk) :: sn0 ! initial salinity 34 35 35 36 !! * Substitutions 36 37 # include "domzgr_substitute.h90" 37 38 !!---------------------------------------------------------------------- 38 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 39 !! $Id$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 43 43 CONTAINS 44 44 … … 47 47 !! *** ROUTINE dia_ar5 *** 48 48 !! 49 !! ** Purpose : Brief description of the routine49 !! ** Purpose : compute and output some AR5 diagnostics 50 50 !! 51 !! ** Method : description of the methodoloy used to achieve the52 !! objectives of the routine. Be as clear as possible!53 !!54 !! ** Action : - first action (share memory array/varible modified55 !! in this routine56 !! - second action .....57 !! - .....58 !!59 !! References : Author et al., Short_name_review, Year60 !! Give references if exist otherwise suppress these lines61 51 !!---------------------------------------------------------------------- 62 52 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 66 56 REAL(wp), DIMENSION(jpi,jpj ) :: zarea_ssh, zbotpres 67 57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd, zrhop 58 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: ztsn 68 59 !!-------------------------------------------------------------------- 69 70 IF( kt == nit000 ) CALL dia_ar5_init ! Initialization (first time-step only)71 60 72 61 CALL iom_put( 'cellthc', fse3t(:,:,:) ) … … 83 72 84 73 ! ! thermosteric ssh 85 CALL eos( tn, sn0, zrhd ) ! now in situ density using initial salinity 86 ! 87 zbotpres(:,:) = 0.e0 ! no atmospheric surface pressure, levitating sea-ice 74 ztsn(:,:,:,jp_tem) = tn (:,:,:) 75 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 76 CALL eos( ztsn, zrhd ) ! now in situ density using initial salinity 77 ! 78 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 88 79 DO jk = 1, jpkm1 89 80 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 90 81 END DO 91 IF( .NOT. 82 IF( .NOT.lk_vvl ) zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 92 83 ! 93 84 zarho = SUM( area(:,:) * zbotpres(:,:) ) … … 97 88 98 89 ! ! steric sea surface height 99 CALL eos( t n,sn, zrhd, zrhop ) ! now in situ and potential density100 zrhop(:,:,jpk) = 0. e090 CALL eos( tsn, zrhd, zrhop ) ! now in situ and potential density 91 zrhop(:,:,jpk) = 0._wp 101 92 CALL iom_put( 'rhop', zrhop ) 102 93 ! 103 zbotpres(:,:) = 0. e0! no atmospheric surface pressure, levitating sea-ice94 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 104 95 DO jk = 1, jpkm1 105 96 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 106 97 END DO 107 IF( .NOT. 98 IF( .NOT.lk_vvl ) zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 108 99 ! 109 100 zarho = SUM( area(:,:) * zbotpres(:,:) ) … … 113 104 114 105 ! ! ocean bottom pressure 115 zztmp = rau0 * grav * 1.e-4 106 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 116 107 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 117 108 CALL iom_put( 'botpres', zbotpres ) 118 109 119 110 ! ! Mean density anomalie, temperature and salinity 120 ztemp = 0. e0121 zsal = 0. e0111 ztemp = 0._wp 112 zsal = 0._wp 122 113 DO jk = 1, jpkm1 123 114 DO jj = 1, jpj 124 115 DO ji = 1, jpi 125 116 zztmp = area(ji,jj) * fse3t(ji,jj,jk) 126 ztemp = ztemp + zztmp * tn 127 zsal = zsal + zztmp * sn 117 ztemp = ztemp + zztmp * tn(ji,jj,jk) 118 zsal = zsal + zztmp * sn(ji,jj,jk) 128 119 END DO 129 120 END DO 130 121 END DO 131 IF( .NOT. 132 ztemp = ztemp + SUM( zarea_ssh(:,:) * tn 133 zsal = zsal + SUM( zarea_ssh(:,:) * sn 122 IF( .NOT.lk_vvl ) THEN 123 ztemp = ztemp + SUM( zarea_ssh(:,:) * tn(:,:,1) ) 124 zsal = zsal + SUM( zarea_ssh(:,:) * sn(:,:,1) ) 134 125 ENDIF 135 126 IF( lk_mpp ) THEN … … 153 144 !! *** ROUTINE dia_ar5_init *** 154 145 !! 155 !! ** Purpose : initialization of .... 156 !! 157 !! ** Method : blah blah blah ... 158 !! 159 !! ** input : Namlist namexa 160 !! 161 !! ** Action : ... 146 !! ** Purpose : initialization for AR5 diagnostic computation 162 147 !!---------------------------------------------------------------------- 163 148 INTEGER :: inum … … 172 157 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 173 158 174 vol0 = 0. e0175 thick0(:,:) = 0. e0159 vol0 = 0._wp 160 thick0(:,:) = 0._wp 176 161 DO jk = 1, jpkm1 177 162 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) ) … … 184 169 CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 ) 185 170 CALL iom_close( inum ) 186 sn0(:,:,:) = 0.5 * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )187 sn0(:,:,:) = sn0(:,:,:) *tmask(:,:,:)171 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 172 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 188 173 IF( ln_zps ) THEN ! z-coord. partial steps 189 174 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 190 175 DO ji = 1, jpi 191 ik = mb athy(ji,jj) - 1192 IF( ik > 2) THEN176 ik = mbkt(ji,jj) 177 IF( ik > 1 ) THEN 193 178 zztmp = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 194 sn0(ji,jj,ik) = ( 1.-zztmp) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)179 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 195 180 ENDIF 196 181 END DO … … 204 189 !! Default option : NO diaar5 205 190 !!---------------------------------------------------------------------- 206 207 191 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE. ! coupled flag 208 209 192 CONTAINS 210 193 SUBROUTINE dia_ar5_init ! Dummy routine 194 END SUBROUTINE dia_ar5_init 211 195 SUBROUTINE dia_ar5( kt ) ! Empty routine 212 INTEGER , INTENT( in ) :: kt ! ocean time-step index196 INTEGER :: kt 213 197 WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt 214 198 END SUBROUTINE dia_ar5
Note: See TracChangeset
for help on using the changeset viewer.