- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r4313 r6225 7 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 8 8 !!---------------------------------------------------------------------- 9 #if defined key_diaar5 || defined key_esopa9 #if defined key_diaar5 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_diaar5' : activate ar5 diagnotics … … 21 21 USE timing ! preformance summary 22 22 USE wrk_nemo ! working arrays 23 USE fldread ! type FLD_N 24 USE phycst ! physical constant 25 USE in_out_manager ! I/O manager 23 26 24 27 IMPLICIT NONE … … 37 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 38 41 39 !! * Substitutions40 # include "domzgr_substitute.h90"41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 83 84 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 84 85 85 CALL iom_put( 'cellthc', fse3t(:,:,:) )86 87 86 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 88 87 … … 98 97 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 99 98 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 100 CALL eos( ztsn, zrhd, fsdept_n(:,:,:) ) ! now in situ density using initial salinity99 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 101 100 ! 102 101 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 103 102 DO jk = 1, jpkm1 104 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 105 END DO 106 IF( .NOT.lk_vvl ) zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 103 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 104 END DO 105 IF( ln_linssh ) THEN 106 IF( ln_isfcav ) THEN 107 DO ji=1,jpi 108 DO jj=1,jpj 109 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 110 END DO 111 END DO 112 ELSE 113 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 114 END IF 115 !!gm 116 !!gm riceload should be added in both ln_linssh=T or F, no? 117 !!gm 118 END IF 107 119 ! 108 120 zarho = SUM( area(:,:) * zbotpres(:,:) ) … … 112 124 113 125 ! ! steric sea surface height 114 CALL eos( tsn, zrhd, zrhop, fsdept_n(:,:,:) ) ! now in situ and potential density126 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 115 127 zrhop(:,:,jpk) = 0._wp 116 128 CALL iom_put( 'rhop', zrhop ) … … 118 130 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 119 131 DO jk = 1, jpkm1 120 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 121 END DO 122 IF( .NOT.lk_vvl ) zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 132 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 133 END DO 134 IF( ln_linssh ) THEN 135 IF ( ln_isfcav ) THEN 136 DO ji=1,jpi 137 DO jj=1,jpj 138 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 139 END DO 140 END DO 141 ELSE 142 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 143 END IF 144 END IF 123 145 ! 124 146 zarho = SUM( area(:,:) * zbotpres(:,:) ) … … 138 160 DO jj = 1, jpj 139 161 DO ji = 1, jpi 140 zztmp = area(ji,jj) * fse3t(ji,jj,jk)162 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 141 163 ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 142 164 zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal) … … 144 166 END DO 145 167 END DO 146 IF( .NOT.lk_vvl ) THEN 147 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 148 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 168 IF( ln_linssh ) THEN 169 IF( ln_isfcav ) THEN 170 DO ji=1,jpi 171 DO jj=1,jpj 172 ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 173 zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 174 END DO 175 END DO 176 ELSE 177 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 178 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 179 END IF 149 180 ENDIF 150 181 IF( lk_mpp ) THEN … … 181 212 REAL(wp) :: zztmp 182 213 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 214 ! reading initial file 215 LOGICAL :: ln_tsd_init !: T & S data flag 216 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag 217 CHARACTER(len=100) :: cn_dir 218 TYPE(FLD_N) :: sn_tem,sn_sal 219 INTEGER :: ios=0 220 221 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal 222 ! 223 224 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist : 225 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 226 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp ) 227 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run 228 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 229 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp ) 230 IF(lwm) WRITE ( numond, namtsd ) 231 ! 183 232 !!---------------------------------------------------------------------- 184 233 ! … … 189 238 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 190 239 191 area(:,:) = e1 t(:,:) *e2t(:,:) * tmask_i(:,:)240 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 192 241 193 242 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) … … 200 249 END DO 201 250 IF( lk_mpp ) CALL mpp_sum( vol0 ) 202 203 CALL iom_open ( 'data_1m_salinity_nomask', inum )204 CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1 )205 CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )251 252 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum ) 253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 ) 254 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 206 255 CALL iom_close( inum ) 207 256 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
Note: See TracChangeset
for help on using the changeset viewer.
