- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r5656 r7351 33 33 USE trdtra 34 34 USE tranxt 35 USE trcbdy ! BDY open boundaries 36 USE bdy_par, only: lk_bdy 35 37 # if defined key_agrif 36 38 USE agrif_top_interp … … 41 43 42 44 PUBLIC trc_nxt ! routine called by step.F90 43 PUBLIC trc_nxt_alloc ! routine called by nemogcm.F9044 45 45 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt46 REAL(wp) :: r2dttrc 46 47 47 48 !!---------------------------------------------------------------------- … … 51 52 !!---------------------------------------------------------------------- 52 53 CONTAINS 53 54 INTEGER FUNCTION trc_nxt_alloc()55 !!----------------------------------------------------------------------56 !! *** ROUTINE trc_nxt_alloc ***57 !!----------------------------------------------------------------------58 ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc )59 !60 IF( trc_nxt_alloc /= 0 ) CALL ctl_warn('trc_nxt_alloc : failed to allocate array')61 !62 END FUNCTION trc_nxt_alloc63 64 54 65 55 SUBROUTINE trc_nxt( kt ) … … 101 91 WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 102 92 ENDIF 103 93 ! 104 94 #if defined key_agrif 105 95 CALL Agrif_trc ! AGRIF zoom boundaries 106 96 #endif 107 ! Update after tracer on domain lateral boundaries 108 DO jn = 1, jptra 97 DO jn = 1, jptra ! Update after tracer on domain lateral boundaries 109 98 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 110 99 END DO 111 100 101 IF( lk_bdy ) CALL trc_bdy( kt ) 112 102 113 #if defined key_bdy 114 !! CALL bdy_trc( kt ) ! BDY open boundaries 115 #endif 116 117 118 ! set time step size (Euler/Leapfrog) 119 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dt(:) = rdttrc(:) ! at nittrc000 (Euler) 120 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog) 103 ! ! set time step size (Euler/Leapfrog) 104 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dttrc = rdttrc ! at nittrc000 (Euler) 105 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dttrc = 2.* rdttrc ! at nit000 or nit000+1 (Leapfrog) 121 106 ENDIF 122 107 123 ! trends computation initialisation 124 IF( l_trdtrc ) THEN 125 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) !* store now fields before applying the Asselin filter 108 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 109 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) 126 110 ztrdt(:,:,:,:) = trn(:,:,:,:) 127 111 ENDIF 128 ! Leap-Frog + Asselin filter time stepping 129 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step 130 ! ! (only swap) 112 ! ! Leap-Frog + Asselin filter time stepping 113 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! Euler time-stepping at first time-step (only swap) 131 114 DO jn = 1, jptra 132 115 DO jk = 1, jpkm1 … … 134 117 END DO 135 118 END DO 136 ! 137 ELSE 138 ! Leap-Frog + Asselin filter time stepping 139 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 140 & sbc_trc, sbc_trc_b, jptra ) ! variable volume level (vvl) 141 ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 119 ELSE ! Asselin filter + swap 120 IF( ln_linssh ) THEN ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! linear ssh 121 ELSE ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 122 & sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 142 123 ENDIF 124 ! 125 DO jn = 1, jptra 126 CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp ) 127 CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp ) 128 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp ) 129 END DO 143 130 ENDIF 144 145 ! trends computation 146 IF( l_trdtrc ) THEN ! trends 131 ! 132 IF( l_trdtrc ) THEN ! trends: send Asselin filter trends to trdtra manager for further diagnostics 147 133 DO jn = 1, jptra 148 134 DO jk = 1, jpkm1 149 zfact = 1. e0 / r2dt(jk)135 zfact = 1._wp / r2dttrc 150 136 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 151 137 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )
Note: See TracChangeset
for help on using the changeset viewer.