Changeset 6570 for branches/CNRS
- Timestamp:
- 2016-05-19T13:13:27+02:00 (8 years ago)
- Location:
- branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM
- Files:
-
- 23 added
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/ARCH/arch-macport_osx.fcm
r6204 r6570 54 54 %CPP cpp-mp-4.8 55 55 %FC mpif90 56 %FCFLAGS -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer 56 %FCFLAGS -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer -ffree-line-length-none 57 57 %FFLAGS %FCFLAGS 58 58 %LD %FC -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/CONFIG/cfg.txt
r6348 r6570 11 11 GYRE OPA_SRC 12 12 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 13 ORCA2_LIM3_AGE OPA_SRC LIM_SRC_3 NST_SRC TOP_SRC -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r5147 r6570 51 51 SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv, & 52 52 & pgui, pgvi, & 53 & ptb, pta, kjpt ) 53 & ptb, pta, kjpt, & 54 & ptru, ptrv, ptrw ) 54 55 !!---------------------------------------------------------------------- 55 56 !! *** ROUTINE tra_ldf_bilap *** … … 87 88 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 88 89 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(out ), OPTIONAL :: ptru, ptrv, ptrw ! optional u/v/w-tracer trend 91 89 92 !! 90 93 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 177 180 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 178 181 ENDIF 182 ! 183 IF( PRESENT( ptru ) ) THEN 184 ptru(:,:,:,jn) = ztu(:,:,:) 185 ptrv(:,:,:,jn) = ztv(:,:,:) 186 ptrw(:,:,:,jn) = 0. 187 ENDIF 179 188 ! ! =========== 180 189 END DO ! tracer loop -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5149 r6570 51 51 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv, & 52 52 & pgui, pgvi, & 53 & ptb, pta, kjpt, pahtb0 ) 53 & ptb, pta, kjpt, pahtb0, & 54 & ptru, ptrv, ptrw ) 54 55 !!---------------------------------------------------------------------- 55 56 !! *** ROUTINE tra_ldf_iso *** … … 102 103 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 103 104 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 105 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(out ), OPTIONAL :: ptru, ptrv, ptrw ! optional u/v/w-tracer trend 106 104 107 ! 105 108 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 320 323 END DO 321 324 ! 325 IF( PRESENT( ptru ) ) THEN 326 ptru(:,:,:,jn) = zftu(:,:,:) 327 ptrv(:,:,:,jn) = zftv(:,:,:) 328 ptrw(:,:,:,jn) = ztfw(:,:,:) 329 ENDIF 330 ! 322 331 END DO 323 332 ! -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5147 r6570 45 45 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu , pgv , & 46 46 & pgui, pgvi, & 47 & ptb, pta, kjpt ) 47 & ptb, pta, kjpt, & 48 & ptru, ptrv, ptrw ) 48 49 !!---------------------------------------------------------------------- 49 50 !! *** ROUTINE tra_ldf_lap *** … … 73 74 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 74 75 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 76 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(out ), OPTIONAL :: ptru, ptrv, ptrw ! optional u/v/w-tracer trend 77 75 78 ! 76 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 158 161 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 159 162 ENDIF 163 ! 164 IF( PRESENT( ptru ) ) THEN 165 ptru(:,:,:,jn) = ztu(:,:,:) 166 ptrv(:,:,:,jn) = ztv(:,:,:) 167 ptrw(:,:,:,jn) = 0. 168 ENDIF 169 ! 160 170 ! ! ================== 161 171 END DO ! end of tracer loop -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
r3680 r6570 7 7 !!---------------------------------------------------------------------- 8 8 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 9 !! $Id$ 9 !! $Id$ 10 10 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 11 11 !!---------------------------------------------------------------------- … … 25 25 USE par_c14b , ONLY : jp_c14b_trd !: number of tracers in C14 26 26 27 USE par_age , ONLY : jp_age !: number of tracers in AGE 28 USE par_age , ONLY : jp_age_2d !: number of tracers in AGE 29 USE par_age , ONLY : jp_age_3d !: number of tracers in AGE 30 USE par_age , ONLY : jp_age_trd !: number of tracers in AGE 31 27 32 IMPLICIT NONE 28 33 29 INTEGER, PARAMETER :: jp_lm = jp_pisces + jp_cfc + jp_c14b !:30 INTEGER, PARAMETER :: jp_lm_2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d !:31 INTEGER, PARAMETER :: jp_lm_3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d !:32 INTEGER, PARAMETER :: jp_lm_trd = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !:34 INTEGER, PARAMETER :: jp_lm = jp_pisces + jp_cfc + jp_c14b + jp_age !: 35 INTEGER, PARAMETER :: jp_lm_2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_age_2d !: 36 INTEGER, PARAMETER :: jp_lm_3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_age_3d !: 37 INTEGER, PARAMETER :: jp_lm_trd = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd !: 33 38 34 39 #if defined key_my_trc -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r5385 r6570 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 28 USE prtctl_trc ! Print control 29 USE diasub 30 USE trcdiasub 31 29 32 30 33 IMPLICIT NONE … … 106 109 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 107 110 108 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) 109 & CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 111 112 IF( lk_diasub ) CALL trc_dia_sub_adv( kt, zun, zvn, zwn ) ! no eiv 113 114 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) THEN ! add the eiv transport (if necessary) 115 CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 116 IF( lk_diasub ) CALL trc_dia_sub_adv_eiv( kt, zun, zvn, zwn ) 117 ENDIF 118 110 119 ! 111 120 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport (if necessary) -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r6312 r6570 28 28 USE trdtra 29 29 USE prtctl_trc ! Print control 30 USE diasub 31 USE trcdiasub 32 30 33 31 34 IMPLICIT NONE … … 60 63 CHARACTER (len=22) :: charout 61 64 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 65 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztfu, ztfv, ztfw 62 66 !!---------------------------------------------------------------------- 63 67 ! … … 84 88 ztrtrd(:,:,:,:) = tra(:,:,:,:) 85 89 ENDIF 90 ! 91 IF( lk_diasub ) THEN 92 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztfu, ztfv, ztfw ) 93 ztfu(:,:,:,:) = 0. ; ztfv(:,:,:,:) = 0. ; ztfw(:,:,:,:) = 0. 94 ENDIF 86 95 87 96 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 88 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level laplacian 89 CASE ( 1 ) ! rotated laplacian 90 IF( ln_traldf_grif ) THEN 91 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 92 ELSE 93 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 94 ENDIF 95 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level bilaplacian 97 CASE ( 0 ) ! iso-level laplacian 98 IF( lk_diasub ) THEN ; CALL tra_ldf_lap( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, ztfu, ztfv, ztfw ) 99 ELSE ; CALL tra_ldf_lap( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 100 ENDIF 101 CASE ( 1 ) 102 IF( ln_traldf_grif ) THEN 103 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 104 ELSE 105 IF( lk_diasub ) THEN 106 CALL tra_ldf_iso( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0, ztfu, ztfv, ztfw ) 107 ELSE 108 CALL tra_ldf_iso( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 109 ENDIF 110 ENDIF 111 CASE ( 2 ) ! iso-level bilaplacian 112 IF( lk_diasub ) THEN ; CALL tra_ldf_bilap( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, ztfu, ztfv, ztfw ) 113 ELSE ; CALL tra_ldf_bilap( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 114 ENDIF 96 115 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 97 116 ! … … 123 142 ENDIF 124 143 ! ! print mean trends (used for debugging) 144 IF( lk_diasub ) THEN 145 CALL trc_dia_sub_ldf( kt, ztfu, ztfv, ztfw ) 146 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztfu, ztfv, ztfw ) 147 ENDIF 148 ! ! print mean trends (used for debugging) 125 149 IF( ln_ctl ) THEN 126 150 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r4990 r6570 28 28 !!---------------------------------------------------------------------- 29 29 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 30 !! $Id$ 30 !! $Id$ 31 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- … … 61 61 ENDIF 62 62 63 IF( lk_age ) CALL trc_rad_sms( kt, trb, trn, jp_age0 , jp_age1 ) ! AGE tracer 63 64 IF( lk_cfc ) CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1 ) ! CFC model 64 65 IF( lk_c14b ) CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1 ) ! bomb C14 -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r5385 r6570 22 22 USE trdtra 23 23 USE prtctl_trc ! Print control 24 USE diasub 25 USE trcdiasub 26 24 27 25 28 IMPLICIT NONE … … 79 82 ENDIF 80 83 81 IF( l_trdtrc ) THEN84 IF( l_trdtrc .OR. lk_diasub ) THEN 82 85 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 83 86 ztrtrd(:,:,:,:) = tra(:,:,:,:) … … 97 100 END SELECT 98 101 99 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics102 IF( l_trdtrc .OR. lk_diasub ) THEN ! save the vertical diffusive trends for further diagnostics 100 103 DO jn = 1, jptra 101 104 DO jk = 1, jpkm1 102 105 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 103 106 END DO 104 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) )107 IF( l_trdtrc ) CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) !DC 105 108 END DO 109 IF( lk_diasub ) CALL trc_dia_sub_zdf( kt, ztrtrd ) 106 110 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 107 111 ENDIF 108 ! ! print mean trends (used for debugging)112 ! 109 113 IF( ln_ctl ) THEN 110 114 WRITE(charout, FMT="('zdf ')") ; CALL prt_ctl_trc_info(charout) -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r4529 r6570 14 14 USE par_c14b ! C14 bomb tracer 15 15 USE par_cfc ! CFC 11 and 12 tracers 16 USE par_age ! AGE tracer 16 17 USE par_my_trc ! user defined passive tracers 17 18 … … 24 25 ! Passive tracers : Total size 25 26 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 26 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_ my_trc27 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_ my_trc_2d28 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_ my_trc_3d27 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_age + jp_my_trc 28 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_age_2d + jp_my_trc_2d 29 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_age_3d + jp_my_trc_3d 29 30 ! ! total number of sms diagnostic arrays 30 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_ my_trc_trd31 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd + jp_my_trc_trd 31 32 32 33 ! 1D configuration ("key_c1d") … … 42 43 !!---------------------------------------------------------------------- 43 44 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 !! $Id$ 45 !! $Id$ 45 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 47 !!====================================================================== -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6308 r6570 23 23 USE trcini_pisces ! PISCES initialisation 24 24 USE trcini_c14b ! C14 bomb initialisation 25 USE trcini_age ! AGE initialisation 25 26 USE trcini_my_trc ! MY_TRC initialisation 26 27 USE trcdta ! initialisation from files … … 99 100 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 100 101 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 102 IF( lk_age ) CALL trc_ini_age ! AGE tracer 101 103 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 102 104 … … 198 200 USE trdmxl_trc , ONLY: trd_mxl_trc_alloc 199 201 #endif 202 #if defined key_diasub 203 USE trcdiasub , ONLY: trc_dia_sub_alloc 204 #endif 200 205 ! 201 206 INTEGER :: ierr … … 210 215 ierr = ierr + trd_mxl_trc_alloc() 211 216 #endif 217 #if defined key_diasub 218 ierr = ierr + trc_dia_sub_alloc() 219 #endif 212 220 ! 213 221 IF( lk_mpp ) CALL mpp_sum( ierr ) -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r6204 r6570 24 24 USE trcnam_cfc ! CFC SMS namelist 25 25 USE trcnam_c14b ! C14 SMS namelist 26 USE trcnam_age ! AGE SMS namelist 26 27 USE trcnam_my_trc ! MY_TRC SMS namelist 27 28 USE trd_oce … … 61 62 62 63 ! ! passive tracer informations 63 CALL trc_nam_trc64 CALL trc_nam_trc 64 65 65 66 ! ! Parameters of additional diagnostics 66 CALL trc_nam_dia67 IF( .NOT. lk_iomput) CALL trc_nam_dia 67 68 68 69 ! ! namelist of transport 69 CALL trc_nam_trp70 CALL trc_nam_trp 70 71 71 72 … … 161 162 ENDIF 162 163 163 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 164 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 165 ENDIF 166 167 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers 168 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 164 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 165 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 166 ENDIF 167 168 IF( lk_age ) THEN ; CALL trc_nam_age ! AGE tracer 169 ELSE ; IF(lwp) WRITE(numout,*) ' AGE not used' 170 ENDIF 171 172 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers 173 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 169 174 ENDIF 170 175 ! … … 359 364 ENDIF 360 365 361 IF( ln_diatrc .AND. .NOT. lk_iomput) THEN366 IF( ln_diatrc ) THEN 362 367 ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 363 368 & ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) , & … … 370 375 ENDIF 371 376 372 IF( ( ln_diabio .AND. .NOT. lk_iomput ).OR. l_trdtrc ) THEN377 IF( ln_diabio .OR. l_trdtrc ) THEN 373 378 ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 374 379 & ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr ) -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r6204 r6570 18 18 USE trcsms_cfc ! CFC 11 & 12 19 19 USE trcsms_c14b ! C14b tracer 20 USE trcsms_age ! AGE tracer 20 21 USE trcsms_my_trc ! MY_TRC tracers 21 22 USE prtctl_trc ! Print control for debbuging … … 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 30 !! $Id$ 31 !! $Id$ 31 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 33 !!---------------------------------------------------------------------- … … 51 52 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 52 53 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 54 IF( lk_age ) CALL trc_sms_age ( kt ) ! AGE tracer 53 55 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 54 56 -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6204 r6570 24 24 USE in_out_manager 25 25 USE trcsub 26 USE diasub 27 26 28 27 29 IMPLICIT NONE … … 75 77 ! 76 78 IF( l_trcdm2dc ) CALL trc_mean_qsr( kt ) 79 ! 80 IF( lk_diasub ) CALL dia_sub( kt ) 77 81 ! 78 82 IF( nn_dttrc /= 1 ) CALL trc_sub_stp( kt ) ! averaging physical variables for sub-stepping -
branches/CNRS/dev_r6568_Subduction_Diagnostics/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r3750 r6570 20 20 USE trcwri_cfc 21 21 USE trcwri_c14b 22 USE trcwri_age 22 23 USE trcwri_my_trc 24 USE diasub 25 USE trcdiasub 26 23 27 24 28 IMPLICIT NONE … … 59 63 IF( lk_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 60 64 IF( lk_c14b ) CALL trc_wri_c14b ! surface fluxes of C14 65 IF( lk_age ) CALL trc_wri_age ! AGE tracer 61 66 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 67 ! 68 IF( lk_diasub ) CALL trc_wri_sub ! Subduction diagnostics 62 69 ! 63 70 IF( nn_timing == 1 ) CALL timing_stop('trc_wri') 64 71 ! 65 72 END SUBROUTINE trc_wri 73 74 # if defined key_diasub 75 76 SUBROUTINE trc_wri_sub 77 !!---------------------------------------------------------------------- 78 !! *** ROUTINE trc_wri_sub *** 79 !! 80 !! ** Purpose : output of passive tracer : advection-diffusion subduction subduction 81 !! 82 !!---------------------------------------------------------------------- 83 CHARACTER(len=8), DIMENSION(jptrsub) :: cltra1 84 CHARACTER(len=20) :: cltra, cltra2 85 INTEGER :: jn, jl, ji, jj, ik 86 REAL(wp), DIMENSION(jpi,jpj) :: zsed 87 REAL(wp), DIMENSION(jpi,jpj,jptrsub) :: ztrsubtpoc 88 !!---------------------------------------------------------------------- 89 90 DO jl = 1, jptrsub 91 IF( jl == jpsub_xad ) cltra1(jl) = TRIM("xad_sub_") ! x advection for tracer 92 IF( jl == jpsub_yad ) cltra1(jl) = TRIM("yad_sub_") ! y advection for tracer 93 IF( jl == jpsub_zad ) cltra1(jl) = TRIM("zad_sub_") ! z advection for tracer 94 IF( jl == jpsub_mld ) cltra1(jl) = TRIM("mld_sub_") ! mld for tracer 95 IF( jl == jpsub_xlf ) cltra1(jl) = TRIM("xlf_sub_") ! x lateral diffusion for tracer 96 IF( jl == jpsub_ylf ) cltra1(jl) = TRIM("ylf_sub_") ! y lateral diffusion for tracer 97 IF( jl == jpsub_zlf ) cltra1(jl) = TRIM("zlf_sub_") ! z lateral diffusion for tracer 98 IF( jl == jpsub_zdf ) cltra1(jl) = TRIM("zdf_sub_") ! z vertical diffusion for tracer 99 #if defined key_trcldf_eiv 100 IF( jl == jpsub_xei ) cltra1(jl) = TRIM("xei_sub_") ! x gent velocity for tracer 101 IF( jl == jpsub_yei ) cltra1(jl) = TRIM("yei_sub_") ! y gent velocity for tracer 102 IF( jl == jpsub_zei ) cltra1(jl) = TRIM("zei_sub_") ! z gent velocity for tracer 103 #endif 104 ENDDO 105 ! 106 # if defined key_pisces 107 DO jl = 1, jptrsub 108 ! write the trends 109 DO jn = 1, jptra 110 IF( jn == jpdic .OR. jn == jptal .OR. jn == jpoxy .OR. jn == jpdoc .OR. jn == jpcal & 111 & .OR. jn == jpno3 .OR. jn == jppo4 .OR. jn == jpsil .OR. jn == jpfer .OR. jn == jpnh4 ) THEN 112 cltra = TRIM(cltra1(jl))//TRIM(ctrcnm(jn)) 113 CALL iom_put( cltra, trsub(:,:,jn,jl) ) 114 ENDIF 115 END DO 116 ! 117 ! Sum of subduction of phy, phy2, zoo, zoo2, POC et GOC 118 ztrsubtpoc(:,:,jl) = trsub(:,:,jpphy,jl) + trsub(:,:,jpdia,jl) & 119 & + trsub(:,:,jpzoo,jl) + trsub(:,:,jpmes,jl) & 120 & + trsub(:,:,jppoc,jl) + trsub(:,:,jpgoc,jl) 121 cltra2 = "TOC" 122 cltra = TRIM(cltra1(jl))//TRIM(cltra2) 123 CALL iom_put( cltra, ztrsubtpoc(:,:,jl)) 124 END DO 125 126 ! Sedimentation a la base de la couche de mélane 127 cltra = TRIM("sedsed") 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 ik = nmln(ji,jj) 131 zsed(ji,jj) = ( sinking(ji,jj,ik) + sinking2(ji,jj,ik) ) * tmask(ji,jj,ik) 132 END DO 133 END DO 134 CALL iom_put( cltra, zsed(:,:) ) 135 #else 136 DO jl = 1, jptrsub 137 ! write the trends 138 DO jn = 1, jptra 139 cltra = TRIM(cltra1(jl))//TRIM(ctrcnm(jn)) 140 CALL iom_put( cltra, trsub(:,:,jn,jl) ) 141 END DO 142 ! 143 END DO 144 #endif 145 ! 146 ! une fois ecrit, trsub est remis a 0 147 DO jl = 1, jptrsub 148 DO jn = 1, jptra 149 trsub(:,:,jn,jl) = 0. 150 END DO 151 END DO 152 ! 153 END SUBROUTINE trc_wri_sub 154 155 # endif 66 156 67 157 #else … … 78 168 !!---------------------------------------------------------------------- 79 169 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 80 !! $Id$ 170 !! $Id$ 81 171 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 82 172 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.