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 10322 for NEMO/branches/UKMO/dev_r9950_GO8_package/src/TOP/PISCES/SED/sedwri.F90 – NEMO

Ignore:
Timestamp:
2018-11-16T16:06:47+01:00 (5 years ago)
Author:
davestorkey
Message:

UKMO/dev_r9950_GO8_package: Update to be relative to rev 10321 of NEMO4_beta_mirror branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r9950_GO8_package/src/TOP/PISCES/SED/sedwri.F90

    r9950 r10322  
    11MODULE sedwri 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!                     ***  MODULE  sedwri  *** 
     
    76   USE sed 
    87   USE sedarr 
    9    USE ioipsl 
    10    USE dianam    ! build name of file (routine) 
     8   USE lib_mpp         ! distribued memory computing library 
     9   USE iom 
    1110 
    1211   IMPLICIT NONE 
     
    1514   !! * Accessibility 
    1615   PUBLIC sed_wri  
    17  
    18    INTEGER  :: nised 
    19    INTEGER  :: nhorised 
    20    INTEGER  :: ndimt52 
    21    INTEGER  :: ndimt51 
    22    INTEGER  :: ndepsed 
    23    REAL(wp) :: zjulian 
    24    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext52   
    25    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 
    2616 
    2717   !! $Id$ 
     
    4333      INTEGER, INTENT(in) :: kt 
    4434 
    45       CHARACTER(len = 60)  ::  clhstnam, clop 
    46       INTEGER  :: ji, jk, js, jw, jn 
    47       REAL(wp) :: zsto,zout, zdt 
    48       INTEGER  :: iimi, iima, ijmi, ijma,ipk, it, itmod 
    49       CHARACTER(len = 20)  ::  cltra , cltrau 
    50       CHARACTER(len = 80)  ::  cltral 
     35      INTEGER  :: ji, jj, jk, js, jw, jn 
     36      INTEGER  :: it 
     37      CHARACTER(len = 20)  ::  cltra  
    5138      REAL(wp)  :: zrate 
    5239      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx 
     
    5744      ! Initialisation 
    5845      ! -----------------  
    59       IF( kt == nittrc000 )   ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 
    60  
    61       ! Define frequency of output and means 
    62       zdt = dtsed 
    63       IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!) 
    64       ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time) 
    65       ENDIF 
    66 #if defined key_diainstant 
    67       zsto = nwrised * zdt 
    68       clop = "inst("//TRIM(clop)//")" 
    69 #else 
    70       zsto = zdt 
    71       clop = "ave("//TRIM(clop)//")" 
    72 #endif 
    73       zout = nwrised * zdt 
    74  
    75       ! Define indices of the horizontal output zoom and vertical limit storage 
    76       iimi = 1      ;      iima = jpi 
    77       ijmi = 1      ;      ijma = jpj 
    78       ipk = jpksed 
    79  
    80       ! define time axis 
    81       it = kt 
    82       itmod = kt - nitsed000 + 1 
    83  
    8446 
    8547      ! 1.  Initilisations 
    8648      ! ----------------------------------------------------------------- 
    87       WRITE(numsed,*) ' ' 
    88       WRITE(numsed,*) 'sed_wri kt = ', kt 
    89       WRITE(numsed,*) ' ' 
     49      IF( ln_timing )  CALL timing_start('sed_wri') 
     50! 
     51      IF (lwp) WRITE(numsed,*) ' ' 
     52      IF (lwp) WRITE(numsed,*) 'sed_wri kt = ', kt 
     53      IF (lwp) WRITE(numsed,*) ' ' 
    9054       
    9155      ALLOCATE( zdta(jpoce,jpksed) )    ;   ALLOCATE( zflx(jpoce,jpwatp1) ) 
    9256 
     57      ! Initialize variables 
     58      ! -------------------- 
     59 
     60      trcsedi(:,:,:,:)   = 0.0 
     61      flxsedi3d(:,:,:,:) = 0.0 
     62      flxsedi2d(:,:,:)   = 0.0 
    9363 
    9464      ! 2.  Back to 2D geometry 
    9565      ! ----------------------------------------------------------------- 
    96       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 
    97          &                    solcp(1:jpoce,1:jpksed,jsopal ) ) 
     66      DO jn = 1, jpsol 
     67         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 
     68         &                       solcp(1:jpoce,1:jpksed,jn ) ) 
     69      END DO 
    9870       
    99       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 
    100          &                    solcp(1:jpoce,1:jpksed,jsclay ) ) 
    101        
    102       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 
    103          &                    solcp(1:jpoce,1:jpksed,jspoc  ) ) 
    104        
    105       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & 
    106          &                    solcp(1:jpoce,1:jpksed,jscal  ) )    
    107              
    108       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & 
    109          &                    pwcp(1:jpoce,1:jpksed,jwsil  )  ) 
    110        
    111       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6)  , iarroce(1:jpoce), & 
    112          &                    pwcp(1:jpoce,1:jpksed,jwoxy  ) ) 
    113        
    114       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7)  , iarroce(1:jpoce), & 
    115          &                    pwcp(1:jpoce,1:jpksed,jwdic  ) ) 
    116        
    117       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8)  , iarroce(1:jpoce), & 
    118          &                    pwcp(1:jpoce,1:jpksed,jwno3  ) ) 
    119        
    120       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9)  , iarroce(1:jpoce), & 
    121          &                    pwcp(1:jpoce,1:jpksed,jwpo4  ) ) 
    122        
    123       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10)  , iarroce(1:jpoce), & 
    124          &                    pwcp(1:jpoce,1:jpksed,jwalk  ) ) 
    125        
    126       CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11)  , iarroce(1:jpoce), & 
    127          &                    pwcp(1:jpoce,1:jpksed,jwc13  ) ) 
    128        
     71      DO jn = 1, jpwat 
     72         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol + jn) , iarroce(1:jpoce), & 
     73         &                       pwcp(1:jpoce,1:jpksed,jn  )  ) 
     74      END DO       
     75 
    12976      ! porosity 
    13077      zdta(:,:) = 0. 
    13178      DO jk = 1, jpksed 
    13279         DO ji = 1, jpoce 
    133             zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) 
     80            zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 
    13481         ENDDO 
    13582      ENDDO 
     83 
    13684      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), & 
    13785         &                   zdta(1:jpoce,1:jpksed)  ) 
     
    14088         &                   co3por(1:jpoce,1:jpksed)  ) 
    14189       
    142        
    143       ! computation of delta 13C 
    144       zdta(:,:) = 0. 
    145       DO jk = 1, jpksed 
    146          DO ji = 1, jpoce 
    147             zdta(ji,jk) = ( ( pwcp(ji,jk,jwc13) / pwcp(ji,jk,jwdic) / pdb ) - 1. ) & 
    148                &              * 1000. 
    149          ENDDO 
    150       ENDDO 
    151       CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3)  , iarroce(1:jpoce), & 
    152          &                   zdta(1:jpoce,1:jpksed)  ) 
    153        
    154   
     90!      flxsedi3d = 0. 
    15591      zflx(:,:) = 0.     
    15692      ! Calculation of fluxes mol/cm2/s 
     
    15894         DO ji = 1, jpoce 
    15995            zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & 
    160                &         * 1.e-3 * dzkbot(ji) / dtsed 
     96               &         * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc 
    16197         ENDDO 
    16298      ENDDO 
     99 
    163100      ! Calculation of accumulation rate per dt 
    164101      DO js = 1, jpsol 
    165          zrate =  mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed 
     102         zrate =  1.0 / ( denssol * por1(jpksed) ) / r2dttrc 
    166103         DO ji = 1, jpoce 
    167104            zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate 
     
    169106      ENDDO 
    170107 
    171       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,1), iarroce(1:jpoce), zflx(1:jpoce,1)  ) 
    172       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,2), iarroce(1:jpoce), zflx(1:jpoce,2)  ) 
    173       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,3), iarroce(1:jpoce), zflx(1:jpoce,3)  ) 
    174       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,4), iarroce(1:jpoce), zflx(1:jpoce,4)  ) 
    175       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,5), iarroce(1:jpoce), zflx(1:jpoce,5)  ) 
    176       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,6), iarroce(1:jpoce), zflx(1:jpoce,6)  ) 
    177       CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,7), iarroce(1:jpoce), zflx(1:jpoce,8)  ) 
    178  
    179  
    180       ! 3. Define NETCDF files and fields at beginning of first time step 
    181       ! ----------------------------------------------------------------- 
    182  
    183       IF( kt == nitsed000 ) THEN 
    184  
    185          ! Define the NETCDF files         
    186          CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 
    187          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    188          CALL dia_nam ( clhstnam, nwrised, 'sed_T' ) 
    189          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,     & 
    190             &             iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    191             &             nitsed000-1, zjulian, zdt,  nhorised, nised , domain_id=nidom, snc4chunks=snc4set ) 
    192          CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' ) 
    193          CALL wheneq  ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) 
    194          CALL wheneq  ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 ) 
    195  
    196          ! Declare all the output fields as NETCDF variables 
    197  
    198          DO jn = 1, jptrased 
    199             cltra  = sedtrcd(jn)   ! short title for sediment variable 
    200             cltral = sedtrcl(jn)   ! long title for  sediment variable 
    201             cltrau = sedtrcu(jn)   ! unit for  sediment variable 
    202  
    203             CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 
    204                &          ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) 
    205          ENDDO 
    206  
    207          ! 3D diagnostic 
    208          DO jn = 1, jpdia3dsed 
    209             cltra  = seddia3d(jn)   ! short title for 3D diagnostic 
    210             cltral = seddia3l(jn)   ! long title for 3D diagnostic 
    211             cltrau = seddia3u(jn)   ! UNIT for 3D diagnostic 
    212  
    213             CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 
    214                &          ipk, 1, ipk, ndepsed, 32, clop, zsto, zout  ) 
    215          ENDDO 
    216  
    217          ! Fluxes 
    218          DO jn = 1, jpdia2dsed 
    219             cltra  = seddia2d(jn)   ! short title for 2D diagnostic 
    220             cltral = seddia2l(jn)   ! long title for 2D diagnostic 
    221             cltrau = seddia2u(jn)   ! UNIT for 2D diagnostic 
    222              
    223             CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 
    224                &          1, 1, 1, -99, 32, clop, zsto, zout ) 
    225          ENDDO 
    226  
    227  
    228          CALL histend( nised, snc4set ) 
    229  
    230          WRITE(numsed,*) 
    231          WRITE(numsed,*) 'End of NetCDF sediment output file Initialization' 
    232  
    233        ENDIF 
     108      DO jn = 1, jpdia2dsed - 1  
     109         CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jn), iarroce(1:jpoce), zflx(1:jpoce,jn)  ) 
     110      END DO 
     111      zflx(:,1) = dzdep(:) / dtsed 
     112      CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jpdia2dsed), iarroce(1:jpoce), zflx(1:jpoce,1) ) 
    234113 
    235114       ! Start writing data 
     
    237116       DO jn = 1, jptrased 
    238117          cltra = sedtrcd(jn) ! short title for 3D diagnostic 
    239           CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52 ) 
     118          CALL iom_put( cltra, trcsedi(:,:,:,jn) ) 
    240119       END DO 
    241120 
    242121       DO jn = 1, jpdia3dsed 
    243122          cltra = seddia3d(jn) ! short title for 3D diagnostic 
    244           CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52 ) 
     123          CALL iom_put( cltra, flxsedi3d(:,:,:,jn) ) 
    245124       END DO 
    246125 
    247126       DO jn = 1, jpdia2dsed 
    248              cltra = seddia2d(jn) ! short title for 2D diagnostic 
    249              CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn  ), ndimt51, ndext51 ) 
     127          cltra = seddia2d(jn) ! short title for 2D diagnostic 
     128          CALL iom_put( cltra, flxsedi2d(:,:,jn) ) 
    250129       END DO 
    251130 
    252131 
    253       ! 3. Closing all files 
    254       ! -------------------- 
    255       IF( kt == nitsedend  ) THEN 
    256           CALL histclo( nised ) 
    257       ENDIF 
     132      DEALLOCATE( zdta )    ;   DEALLOCATE( zflx ) 
    258133 
    259       DEALLOCATE( zdta )    ;   DEALLOCATE( zflx ) 
     134      IF( ln_timing )  CALL timing_stop('sed_wri') 
    260135 
    261136   END SUBROUTINE sed_wri 
    262137 
    263 #else 
    264    !!====================================================================== 
    265    !! MODULE sedwri  :   Dummy module 
    266    !!====================================================================== 
    267    !! $Id$ 
    268 CONTAINS 
    269    SUBROUTINE sed_wri( kt )         ! Empty routine 
    270       INTEGER, INTENT(in) :: kt 
    271       WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt 
    272    END SUBROUTINE sed_wri 
    273  
    274    !!====================================================================== 
    275 #endif 
    276  
    277138END MODULE sedwri 
Note: See TracChangeset for help on using the changeset viewer.