- Timestamp:
- 2017-12-19T09:47:17+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r9124 r9125 22 22 USE fldread ! type FLD_N 23 23 USE timing ! preformance summary 24 USE wrk_nemo ! working arrays25 24 26 25 IMPLICIT NONE … … 76 75 REAL(wp) :: zaw, zbw, zrw 77 76 ! 78 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 REAL(wp), POINTER, DIMENSION(:,:) :: zpe ! 2D workspace 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe ! 2D workspace 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 82 82 !!-------------------------------------------------------------------- 83 83 IF( ln_timing ) CALL timing_start('dia_ar5') … … 85 85 IF( kt == nit000 ) CALL dia_ar5_init 86 86 87 IF( l_ar5 ) THEN 88 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres)89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop)90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn)87 IF( l_ar5 ) THEN 88 ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(jpi,jpj) ) 89 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 90 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 91 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 92 92 ENDIF … … 212 212 ! Exclude points where rn2 is negative as convection kicks in here and 213 213 ! work is not being done against stratification 214 CALL wrk_alloc( jpi, jpj, zpe)214 ALLOCATE( zpe(jpi,jpj) ) 215 215 zpe(:,:) = 0._wp 216 216 IF( ln_zdfddm ) THEN … … 247 247 !!gm CALL lbc_lnk( zpe, 'T', 1._wp) 248 248 CALL iom_put( 'tnpeo', zpe ) 249 CALL wrk_dealloc( jpi, jpj,zpe )250 ENDIF 251 ! 249 DEALLOCATE( zpe ) 250 ENDIF 251 252 252 IF( l_ar5 ) THEN 253 CALL wrk_dealloc( jpi , jpj ,zarea_ssh , zbotpres )254 CALL wrk_dealloc( jpi , jpj , jpk ,zrhd , zrhop )255 CALL wrk_dealloc( jpi , jpj , jpk , jpts ,ztsn )253 DEALLOCATE( zarea_ssh , zbotpres ) 254 DEALLOCATE( zrhd , zrhop ) 255 DEALLOCATE( ztsn ) 256 256 ENDIF 257 257 ! … … 274 274 ! 275 275 INTEGER :: ji, jj, jk 276 REAL(wp), POINTER, DIMENSION(:,:) :: z2d276 REAL(wp), DIMENSION(jpi,jpj) :: z2d 277 277 278 278 279 280 CALL wrk_alloc( jpi, jpj, z2d )281 279 z2d(:,:) = pua(:,:,1) 282 280 DO jk = 1, jpkm1 … … 315 313 ENDIF 316 314 317 CALL wrk_dealloc( jpi, jpj, z2d )318 319 315 END SUBROUTINE dia_ar5_hst 320 316 … … 330 326 INTEGER :: ji, jj, jk ! dummy loop indices 331 327 REAL(wp) :: zztmp 332 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity328 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 333 329 ! 334 330 !!---------------------------------------------------------------------- … … 341 337 IF( l_ar5 ) THEN 342 338 ! 343 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )344 339 ! ! allocate dia_ar5 arrays 345 340 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 357 352 IF( lk_mpp ) CALL mpp_sum( vol0 ) 358 353 359 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 360 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 361 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 362 CALL iom_close( inum ) 363 364 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 365 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 366 IF( ln_zps ) THEN ! z-coord. partial steps 367 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 368 DO ji = 1, jpi 369 ik = mbkt(ji,jj) 370 IF( ik > 1 ) THEN 371 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 372 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 373 ENDIF 374 END DO 375 END DO 354 IF( iom_use( 'sshthster' ) ) THEN 355 ALLOCATE( zsaldta(jpi,jpj,jpj,jpts) ) 356 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 357 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 358 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 359 CALL iom_close( inum ) 360 361 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 362 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 363 IF( ln_zps ) THEN ! z-coord. partial steps 364 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 365 DO ji = 1, jpi 366 ik = mbkt(ji,jj) 367 IF( ik > 1 ) THEN 368 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 369 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 370 ENDIF 371 END DO 372 END DO 373 ENDIF 374 ! 375 DEALLOCATE( zsaldta ) 376 376 ENDIF 377 !378 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )379 377 ! 380 378 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.