- Timestamp:
- 2015-12-23T18:42:01+01:00 (8 years ago)
- Location:
- branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/par_idtra.F90
r5726 r6164 21 21 USE par_medusa , ONLY : jp_medusa_trd !: number of biological diag in MEDUSA 22 22 23 IMPLICIT NONE 23 24 24 IMPLICIT NONE 25 PUBLIC 26 27 INTEGER, PUBLIC, PARAMETER :: jp_lp = jp_pisces + jp_medusa !: cumulative number of passive tracers 28 INTEGER, PUBLIC, PARAMETER :: jp_lp_2d = jp_pisces_2d + jp_medusa_2d !: 29 INTEGER, PUBLIC, PARAMETER :: jp_lp_3d = jp_pisces_3d + jp_medusa_3d !: 30 INTEGER, PUBLIC, PARAMETER :: jp_lp_trd = jp_pisces_trd + jp_medusa_trd !: 25 INTEGER, PARAMETER :: jp_lp = jp_pisces + jp_medusa !: cumulative number of passive tracers 26 INTEGER, PARAMETER :: jp_lp_2d = jp_pisces_2d + jp_medusa_2d !: 27 INTEGER, PARAMETER :: jp_lp_3d = jp_pisces_3d + jp_medusa_3d !: 28 INTEGER, PARAMETER :: jp_lp_trd = jp_pisces_trd + jp_medusa_trd !: 31 29 32 30 #if defined key_idtra … … 36 34 LOGICAL, PUBLIC, PARAMETER :: lk_idtra = .TRUE. !: IDEAL-TRACER flag 37 35 INTEGER, PUBLIC, PARAMETER :: jp_idtra = 1 !: number of passive tracers 38 INTEGER, PUBLIC, PARAMETER :: jp_idtra_2d = 0!: additional 2d output arrays ('key_trc_diaadd')36 INTEGER, PUBLIC, PARAMETER :: jp_idtra_2d = 3 !: additional 2d output arrays ('key_trc_diaadd') 39 37 INTEGER, PUBLIC, PARAMETER :: jp_idtra_3d = 0 !: additional 3d output arrays ('key_trc_diaadd') 40 38 INTEGER, PUBLIC, PARAMETER :: jp_idtra_trd = 0 !: number of sms trends for IDEAL-TRACER -
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcini_idtra.F90
r6046 r6164 46 46 !!---------------------------------------------------------------------- 47 47 48 IF(lwp) WRITE(numout,*) 49 IF(lwp) WRITE(numout,*) ' trc_ini_idtra: initialisation of Ideal Tracers model' 50 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 51 52 IF( trc_sms_idtra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_idtra:unable to allocate CFC arrays' ) 53 48 54 49 55 ! Initialization of trn in case of no restart 50 56 !---------------------------------------------- 57 qtr_idtra(:,:,:) = 0._wp 58 inv_idtra(:,:,:) = 0._wp 51 59 IF( .NOT. ln_rsttr ) THEN 52 60 IF(lwp) THEN 53 61 WRITE(numout,*) 54 WRITE(numout,*) 'Initialization deid-tracers ; No restart : '62 WRITE(numout,*) 'Initialization of id-tracers ; No restart : ' 55 63 WRITE(numout,*) ' ; Init field equal 1 at surface - zero elsewhere' 64 WRITE(numout,*) ' ; qint idtra equal 0 ' 56 65 ENDIF 66 qint_idtra(:,:,:) = 0._wp 57 67 DO jn = jp_idtra0, jp_idtra1 58 68 trn(:,:,:,jn) = 0.e0 -
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90
r6046 r6164 25 25 PRIVATE 26 26 27 PUBLIC trc_sms_idtra ! called in ??? 28 27 PUBLIC trc_sms_idtra ! called in ??? 28 PUBLIC trc_sms_idtra_alloc ! called in ??? 29 ! 29 30 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 30 31 INTEGER , PUBLIC :: numnatm 31 32 REAL(wp), PUBLIC :: FDEC 33 ! 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_idtra ! flux at surface 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qint_idtra ! cumulative flux 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: inv_idtra ! vertic. inventory 37 32 38 ! ! coefficients for conversion 33 39 REAL(wp) :: WTEMP … … 75 81 76 82 !!---------------------------------------------------------------------- 77 IF(lwp) WRITE(numout,*) ' - JPALM - verif :' 78 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~' 79 IF(lwp) WRITE(numout,*) ' - idtra decay factor : ', FDEC 83 IF (kt == nittrc000) THEN 84 IF(lwp) WRITE(numout,*) ' - JPALM - verif :' 85 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~' 86 IF(lwp) WRITE(numout,*) ' - idtra decay factor : ', FDEC 87 ENDIF 88 89 ! 90 inv_idtra(:,:,:) = 0.0 !! init the inventory 91 DO jl = 1, jp_idtra 92 jn = jp_idtra0 + jl - 1 93 94 DO jj = 1, jpj 95 DO ji = 1, jpi 96 !! First, a crude version. will be much inproved later. 97 qtr_idtra(ji,jj,jl) = (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) * & 98 fse3t(ji,jj,1) / rdt !! Air-sea Flux 99 ENDDO 100 ENDDO 101 tra(:,:,1,jn) = tra(:,:,1,jn) + ( qtr_idtra(:,:,jl) * & 102 tmask(:,:,1) / fse3t(:,:,1) ) 103 qint_idtra(:,:,jl) = qint_idtra(:,:,jl) + & 104 qtr_idtra(:,:,jl) * rdt !! Cumulative Air-sea Flux 80 105 81 106 82 ! 83 DO jn = jp_idtra0, jp_idtra1 84 85 ! DO jj = 1, jpj 86 ! DO ji = 1, jpi 87 ! Surface concentrarion fixed to 1 (ideal tracer concentration unit) 88 trn(:,:,1,jn) = 1. 89 trb(:,:,1,jn) = 1. 90 ! 91 ! ENDDO 92 ! ENDDO 93 107 DO jk =1,jpk 108 inv_idtra(:,:,jl) = inv_idtra(:,:,jl) + & 109 (trn(:,:,jk,jn) * fse3t(:,:,jk) * tmask(:,:,jk)) !! vertical inventory 110 ENDDO 94 111 ! 95 112 !DECAY of OUR IDEALIZED TRACER … … 101 118 ! IF (trn(ji,jj,jk,jn) > 0.0) THEN 102 119 WTEMP = trn(ji,jj,jk,jn) * (1. - FDEC ) 103 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) - WTEMP/rdt 120 tra(ji,jj,jk,jn) = (tra(ji,jj,jk,jn) - WTEMP/rdt ) * & 121 tmask(ji,jj,jk) 104 122 ! ENDIF 105 123 ENDDO … … 107 125 ENDDO 108 126 109 ENDDO127 ENDDO 110 128 !! jn loop 111 129 ! 112 130 113 !!!!!! No added diagnostics to save here for idealize tracers... 114 !!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 115 !! #if defined key_trc_diaadd 116 !! ! Save diagnostics , just for TRI111 117 !! # if ! defined key_iomput 118 !! trc2d(:,:,jp_idtra0_2d ) = zpp_idtra(:,:) 119 !! # else 120 !! ! WRITE(NUMOUT,*) 'Iomput idtrasurf ' 121 !! CALL iom_put( "TRISURF" , zpp_idtra(:,:) ) 122 !! ! CALL iom_put( "TRISURF" , xphem(:,:) ) 123 !! ! WRITE(NUMOUT,*) 'Iomputage ' 124 !! CALL iom_put( "AGE" , zage(:,:,:) ) 125 !! # endif 126 !! #endif 127 !! 131 ! 132 IF( lrst_trc ) THEN 133 IF(lwp) WRITE(numout,*) 134 IF(lwp) WRITE(numout,*) 'trc_sms_idtra : cumulated input function fields written in ocean restart file ', & 135 & 'at it= ', kt,' date= ', ndastp 136 IF(lwp) WRITE(numout,*) '~~~~' 137 DO jn = jp_idtra0, jp_idtra1 138 CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,jn) ) 139 END DO 140 ENDIF 141 ! 142 IF( lk_iomput ) THEN 143 CALL iom_put( "qtrIDTRA" , qtr_idtra (:,:,1) ) 144 CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) ) 145 CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) ) 146 ELSE 147 IF( ln_diatrc ) THEN 148 trc2d(:,:,jp_idtra0_2d ) = qtr_idtra (:,:,1) 149 trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1) 150 trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1) 151 END IF 152 END IF 153 ! 154 IF( l_trdtrc ) THEN 155 DO jn = jp_idtra0, jp_idtra1 156 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 157 END DO 158 END IF 159 ! 160 IF( nn_timing == 1 ) CALL timing_stop('trc_sms_idtra') 161 ! 162 END SUBROUTINE trc_sms_idtra 128 163 129 !! IF( l_trdtrc ) THEN 130 !! DO jn = jp_idtra0, jp_idtra1 131 !! zidtradtra(:,:,:) = tra(:,:,:,jn) 132 !! CALL trd_mod_trc( zidtradtra, jn, jptrc_trd_sms, kt ) ! save trends 133 !! END DO 134 !! END IF 164 INTEGER FUNCTION trc_sms_idtra_alloc() 165 !!---------------------------------------------------------------------- 166 !! *** ROUTINE trc_sms_idtra_alloc *** 167 !!---------------------------------------------------------------------- 168 ALLOCATE( qtr_idtra (jpi,jpj,jp_idtra) , & 169 & inv_idtra(jpi,jpj,jp_idtra) , & 170 & qint_idtra(jpi,jpj,jp_idtra) , STAT=trc_sms_idtra_alloc ) 171 ! 172 IF( trc_sms_idtra_alloc /= 0 ) CALL ctl_warn('trc_sms_idtra_alloc : failed to allocate arrays.') 173 ! 174 END FUNCTION trc_sms_idtra_alloc 135 175 136 END SUBROUTINE trc_sms_idtra137 176 #else 138 177 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.