New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/C14b – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

Location:
trunk/NEMOGCM/NEMO/TOP_SRC/C14b
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2715 r3294  
    181181      IF( ctrcnm(jpc14) /= 'C14B' ) THEN 
    182182          ctrcnm(jpc14)  = 'C14B' 
    183           ctrcnl(jpc14)  = 'Bomb C14 concentration' 
     183          ctrcln(jpc14)  = 'Bomb C14 concentration' 
    184184      ENDIF 
    185185 
    186186      IF(lwp) THEN 
    187187         CALL ctl_warn( ' we force tracer names' ) 
    188          WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 
     188         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcln(jpc14) 
    189189         WRITE(numout,*) ' ' 
    190190      ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r2715 r3294  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_c14b     ! C14b specific variable 
     18   USE iom             ! I/O manager 
    1819 
    1920   IMPLICIT NONE 
    … …  
    3738      !! 
    3839      !! ** Method  :   Read the namc14 namelist and check the parameter  
    39       !!       values called at the first timestep (nit000) 
     40      !!       values called at the first timestep (nittrc000) 
    4041      !! 
    4142      !! ** input   :   Namelist namelist_c14b 
    … …  
    4344      INTEGER ::   numnatb 
    4445 
    45 #if defined key_diatrc && ! defined key_iomput 
    4646      ! definition of additional diagnostic as a structure 
    47       INTEGER ::   jl, jn 
    48       TYPE DIAG 
    49          CHARACTER(len = 20)  :: snamedia   !: short name 
    50          CHARACTER(len = 80 ) :: lnamedia   !: long name 
    51          CHARACTER(len = 20 ) :: unitdia    !: unit 
    52       END TYPE DIAG 
    53  
    54       TYPE(DIAG) , DIMENSION(jp_c14b_2d) :: c14dia2d 
    55       TYPE(DIAG) , DIMENSION(jp_c14b_3d) :: c14dia3d 
    56 #endif 
     47      INTEGER :: jl, jn 
     48      TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d 
     49      TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d 
    5750      !! 
    5851      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 
    59 #if defined key_diatrc && ! defined key_iomput 
    60       NAMELIST/namc14dia/nn_writedia, c14dia2d, c14dia3d     ! additional diagnostics 
    61 #endif 
     52      NAMELIST/namc14dia/  c14dia2d, c14dia3d     ! additional diagnostics 
    6253      !!------------------------------------------------------------------- 
    6354 
    … …  
    8071      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b 
    8172      ! 
    82 #if defined key_diatrc && ! defined key_iomput 
     73      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     74         ! 
     75         ! Namelist namc14dia 
     76         ! ------------------- 
     77         DO jl = 1, jp_c14b_2d 
     78            WRITE(c14dia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     79            WRITE(c14dia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     80            c14dia2d(jl)%units = ' '                                       ! units 
     81         END DO 
     82         !                                 ! 3D output arrays 
     83         DO jl = 1, jp_c14b_3d 
     84            WRITE(c14dia3d(jl)%sname,'("3D_",I1)') jl                      ! short name 
     85            WRITE(c14dia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     86            c14dia3d(jl)%units = ' '                                       ! units 
     87         END DO 
    8388 
    84       ! Namelist namc14dia 
    85       ! ------------------- 
    86       nn_writedia = 10                   ! default values 
    87  
    88       DO jl = 1, jp_c14b_2d 
    89          jn = jp_c14b0_2d + jl - 1 
    90          WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name 
    91          WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    92          ctrc2u(jn) = ' '                                       ! units 
    93       END DO 
    94       !                                 ! 3D output arrays 
    95       DO jl = 1, jp_c14b_3d 
    96          jn = jp_c14b0_3d + jl - 1 
    97          WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name 
    98          WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    99          ctrc3u(jn) = ' '                                       ! units 
    100       END DO 
    101  
    102       REWIND( numnatb )               ! read natrtd 
    103       READ  ( numnatb, namc14dia ) 
    104  
    105       DO jl = 1, jp_c14b_2d 
    106          jn = jp_c14b0_2d + jl - 1 
    107          ctrc2d(jn) = c14dia2d(jl)%snamedia 
    108          ctrc2l(jn) = c14dia2d(jl)%lnamedia 
    109          ctrc2u(jn) = c14dia2d(jl)%unitdia 
    110       END DO 
    111  
    112       DO jl = 1, jp_c14b_3d 
    113          jn = jp_c14b0_3d + jl - 1 
    114          ctrc3d(jn) = c14dia3d(jl)%snamedia 
    115          ctrc3l(jn) = c14dia3d(jl)%lnamedia 
    116          ctrc3u(jn) = c14dia3d(jl)%unitdia 
    117       END DO 
    118  
    119       IF(lwp) THEN                   ! control print 
    120          WRITE(numout,*) 
    121          WRITE(numout,*) ' Namelist : natadd' 
    122          WRITE(numout,*) '    frequency of outputs for additional arrays nn_writedia = ', nn_writedia 
    123          DO jl = 1, jp_c14b_3d 
    124             jn = jp_c14b0_3d + jl - 1 
    125             WRITE(numout,*) '   3d output field No : ',jn 
    126             WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn)) 
    127             WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn)) 
    128             WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn)) 
    129             WRITE(numout,*) ' ' 
    130          END DO 
     89         REWIND( numnatb )               !  
     90         READ  ( numnatb, namc14dia ) 
    13191 
    13292         DO jl = 1, jp_c14b_2d 
    13393            jn = jp_c14b0_2d + jl - 1 
    134             WRITE(numout,*) '   2d output field No : ',jn 
    135             WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn)) 
    136             WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn)) 
    137             WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn)) 
     94            ctrc2d(jn) = c14dia2d(jl)%sname 
     95            ctrc2l(jn) = c14dia2d(jl)%lname 
     96            ctrc2u(jn) = c14dia2d(jl)%units 
     97         END DO 
     98 
     99         DO jl = 1, jp_c14b_3d 
     100            jn = jp_c14b0_3d + jl - 1 
     101            ctrc3d(jn) = c14dia3d(jl)%sname 
     102            ctrc3l(jn) = c14dia3d(jl)%lname 
     103            ctrc3u(jn) = c14dia3d(jl)%units 
     104         END DO 
     105 
     106         IF(lwp) THEN                   ! control print 
     107            WRITE(numout,*) 
     108            WRITE(numout,*) ' Namelist : natadd' 
     109            DO jl = 1, jp_c14b_3d 
     110               jn = jp_c14b0_3d + jl - 1 
     111               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
     112                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
     113            END DO 
    138114            WRITE(numout,*) ' ' 
    139          END DO 
     115 
     116            DO jl = 1, jp_c14b_2d 
     117               jn = jp_c14b0_2d + jl - 1 
     118               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     119                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     120            END DO 
     121            WRITE(numout,*) ' ' 
     122         ENDIF 
     123         ! 
    140124      ENDIF 
    141  
    142 #endif 
    143125 
    144126   END SUBROUTINE trc_nam_c14b 

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2715 r3294  
    9494      !! 
    9595      !!---------------------------------------------------------------------- 
    96       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    97       USE wrk_nemo, ONLY:   zatmbc14 => wrk_2d_1 
    98       USE wrk_nemo, ONLY:   zw3d     => wrk_3d_1 
    9996      ! 
    10097      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    113110      REAL(wp) :: zpv               ! piston velocity  
    114111      REAL(wp) :: zdemi, ztra 
    115       !!---------------------------------------------------------------------- 
    116  
    117       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 
    118          CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable')   ;   RETURN 
    119       ENDIF 
    120  
    121       IF( kt == nit000 )  THEN         ! Computation of decay coeffcient 
     112      REAL(wp), POINTER, DIMENSION(:,:  ) :: zatmbc14   
     113      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdecay 
     114      !!--------------------------------------------------------------------- 
     115      ! 
     116      IF( nn_timing == 1 )  CALL timing_start('trc_sms_c14b') 
     117      ! 
     118      ! Allocate temporary workspace 
     119      CALL wrk_alloc( jpi, jpj,      zatmbc14 ) 
     120      CALL wrk_alloc( jpi, jpj, jpk, zdecay   ) 
     121 
     122      IF( kt == nittrc000 )  THEN         ! Computation of decay coeffcient 
    122123         zdemi   = 5730._wp 
    123124         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 
    … …  
    246247#endif 
    247248                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 
    248  
    249249            ! Add the surface flux to the trend 
    250250            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)  
    … …  
    252252            ! cumulation of surface flux at each time step 
    253253            qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt 
    254  
    255 # if defined key_diatrc && ! defined key_iomput 
    256             ! Save 2D diagnostics 
    257             trc2d(ji,jj,jp_c14b0_2d    ) = qtr_c14 (ji,jj) 
    258             trc2d(ji,jj,jp_c14b0_2d + 1) = qint_c14(ji,jj) 
    259 # endif  
     254            ! 
    260255         END DO 
    261256      END DO 
    … …  
    265260         DO jj = 1, jpj 
    266261            DO ji = 1, jpi 
    267 #if ! defined key_degrad 
    268                ztra = trn(ji,jj,jk,jpc14) * xaccum 
     262#if defined key_degrad 
     263               zdecay(ji,jj,jk) = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) ) 
    269264#else 
    270                ztra = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) ) 
     265               zdecay(ji,jj,jk) = trn(ji,jj,jk,jpc14) * xaccum 
    271266#endif 
    272                tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - ztra / rdt 
    273 #if defined key_diatrc 
    274                ! Save 3D diagnostics 
    275 # if ! defined key_iomput 
    276                trc3d(ji,jj,jk,jp_c14b0_3d ) = ztra    !  radioactive decay 
    277 # else  
    278                zw3d(ji,jj,jk) = ztra    !  radioactive decay 
    279 # endif 
    280 #endif 
     267               tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - zdecay(ji,jj,jk) / rdt 
     268               ! 
    281269            END DO 
    282270         END DO 
    283271      END DO 
    284272 
    285 #if defined key_diatrc  && defined key_iomput 
    286       CALL iom_put( "qtrC14b"  , qtr_c14  ) 
    287       CALL iom_put( "qintC14b" , qint_c14 ) 
    288 #endif 
    289 #if defined key_diatrc  && defined key_iomput 
    290       CALL iom_put( "fdecay" , zw3d ) 
    291 #endif 
    292       IF( l_trdtrc )   CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    293  
    294       IF( wrk_not_released(2, 1) .OR.   & 
    295           wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays') 
     273      IF( ln_diatrc ) THEN 
     274         IF( lk_iomput ) THEN 
     275            CALL iom_put( "qtrC14b"  , qtr_c14  ) 
     276            CALL iom_put( "qintC14b" , qint_c14 ) 
     277            CALL iom_put( "fdecay"   , zdecay   ) 
     278          ELSE 
     279            trc2d(:,:  ,jp_c14b0_2d     ) = qtr_c14 (:,:) 
     280            trc2d(:,:  ,jp_c14b0_2d + 1 ) = qint_c14(:,:) 
     281            trc3d(:,:,:,jp_c14b0_3d     ) = zdecay  (:,:,:) 
     282          ENDIF 
     283      ENDIF 
     284 
     285      IF( l_trdtrc )  CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
     286 
     287      CALL wrk_dealloc( jpi, jpj,      zatmbc14 ) 
     288      CALL wrk_dealloc( jpi, jpj, jpk, zdecay   ) 
     289      ! 
     290      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_c14b') 
    296291      ! 
    297292   END SUBROUTINE trc_sms_c14b 
Note: See TracChangeset for help on using the changeset viewer.