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 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4570 r5965  
    4444   USE in_out_manager  ! I/O manager 
    4545   USE diadimg         ! dimg direct access file format output 
    46    USE diaar5, ONLY :   lk_diaar5 
    47    USE dynadv, ONLY :   ln_dynadv_vec 
    4846   USE iom 
    4947   USE ioipsl 
     48   USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities      
     49 
    5050#if defined key_lim2 
    5151   USE limwri_2  
     
    8080   !!---------------------------------------------------------------------- 
    8181   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    82    !! $Id $ 
     82   !! $Id$ 
    8383   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8484   !!---------------------------------------------------------------------- 
     
    8989      INTEGER, DIMENSION(2) :: ierr 
    9090      !!---------------------------------------------------------------------- 
    91       ! 
    9291      ierr = 0 
    93       ! 
    9492      ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) ,     & 
    9593         &      ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) ,     & 
     
    129127      !! 
    130128      INTEGER                      ::   ji, jj, jk              ! dummy loop indices 
     129      INTEGER                      ::   jkbot                   ! 
    131130      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    132131      !! 
    133       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d       ! 2D workspace 
     132      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d      ! 2D workspace 
    134133      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d      ! 3D workspace 
    135134      !!---------------------------------------------------------------------- 
     
    146145      ENDIF 
    147146 
    148       IF( lk_vvl ) THEN 
    149          z3d(:,:,:) = tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) 
    150          CALL iom_put( "toce" , z3d                        )   ! heat content 
    151          CALL iom_put( "sst"  , z3d(:,:,1)                 )   ! sea surface heat content 
    152          z3d(:,:,1) = tsn(:,:,1,jp_tem) * z3d(:,:,1) 
    153          CALL iom_put( "sst2" , z3d(:,:,1)                 )   ! sea surface content of squared temperature 
    154          z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:)             
    155          CALL iom_put( "soce" , z3d                        )   ! salinity content 
    156          CALL iom_put( "sss"  , z3d(:,:,1)                 )   ! sea surface salinity content 
    157          z3d(:,:,1) = tsn(:,:,1,jp_sal) * z3d(:,:,1) 
    158          CALL iom_put( "sss2" , z3d(:,:,1)                 )   ! sea surface content of squared salinity 
    159       ELSE 
    160          CALL iom_put( "toce" , tsn(:,:,:,jp_tem)          )   ! temperature 
    161          CALL iom_put( "sst"  , tsn(:,:,1,jp_tem)          )   ! sea surface temperature 
    162          CALL iom_put( "sst2" , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) ) ! square of sea surface temperature 
    163          CALL iom_put( "soce" , tsn(:,:,:,jp_sal)          )   ! salinity 
    164          CALL iom_put( "sss"  , tsn(:,:,1,jp_sal)          )   ! sea surface salinity 
    165          CALL iom_put( "sss2" , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) ) ! square of sea surface salinity 
    166       END IF 
    167       IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 
    168          CALL iom_put( "uoce" , un(:,:,:) * fse3u_n(:,:,:) )    ! i-transport 
    169          CALL iom_put( "voce" , vn(:,:,:) * fse3v_n(:,:,:) )    ! j-transport 
    170       ELSE 
    171          CALL iom_put( "uoce" , un                         )    ! i-current 
    172          CALL iom_put( "voce" , vn                         )    ! j-current 
    173       END IF 
    174       CALL iom_put(    "avt"  , avt                        )    ! T vert. eddy diff. coef. 
    175       CALL iom_put(    "avm"  , avmu                       )    ! T vert. eddy visc. coef. 
    176       IF( lk_zdfddm ) THEN 
    177          CALL iom_put( "avs" , fsavs(:,:,:)                          )    ! S vert. eddy diff. coef. 
    178       ENDIF 
    179  
    180       DO jj = 2, jpjm1                                    ! sst gradient 
    181          DO ji = fs_2, fs_jpim1   ! vector opt. 
    182             zztmp      = tsn(ji,jj,1,jp_tem) 
    183             zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
    184             zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
    185             z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    186                &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    187          END DO 
    188       END DO 
    189       CALL lbc_lnk( z2d, 'T', 1. ) 
    190       CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    191 !CDIR NOVERRCHK 
    192       z2d(:,:) = SQRT( z2d(:,:) ) 
    193       CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    194  
    195       IF( lk_diaar5 ) THEN 
     147      IF( .NOT.lk_vvl ) THEN 
     148         CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 
     149         CALL iom_put( "e3u" , fse3u_n(:,:,:) ) 
     150         CALL iom_put( "e3v" , fse3v_n(:,:,:) ) 
     151         CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 
     152      ENDIF 
     153 
     154      CALL iom_put( "ssh" , sshn )                 ! sea surface height 
     155      if( iom_use('ssh2') )   CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
     156       
     157      CALL iom_put( "toce", tsn(:,:,:,jp_tem) )    ! 3D temperature 
     158      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
     159      IF ( iom_use("sbt") ) THEN 
     160         DO jj = 1, jpj 
     161            DO ji = 1, jpi 
     162               jkbot = mbkt(ji,jj) 
     163               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem) 
     164            END DO 
     165         END DO 
     166         CALL iom_put( "sbt", z2d )                ! bottom temperature 
     167      ENDIF 
     168       
     169      CALL iom_put( "soce", tsn(:,:,:,jp_sal) )    ! 3D salinity 
     170      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
     171      IF ( iom_use("sbs") ) THEN 
     172         DO jj = 1, jpj 
     173            DO ji = 1, jpi 
     174               jkbot = mbkt(ji,jj) 
     175               z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal) 
     176            END DO 
     177         END DO 
     178         CALL iom_put( "sbs", z2d )                ! bottom salinity 
     179      ENDIF 
     180 
     181      IF ( iom_use("taubot") ) THEN                ! bottom stress 
     182         z2d(:,:) = 0._wp 
     183         DO jj = 2, jpjm1 
     184            DO ji = fs_2, fs_jpim1   ! vector opt. 
     185               zztmpx = (  bfrua(ji  ,jj) * un(ji  ,jj,mbku(ji  ,jj))  & 
     186                      &  + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj))  )       
     187               zztmpy = (  bfrva(ji,  jj) * vn(ji,jj  ,mbkv(ji,jj  ))  & 
     188                      &  + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1))  )  
     189               z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)  
     190               ! 
     191            ENDDO 
     192         ENDDO 
     193         CALL lbc_lnk( z2d, 'T', 1. ) 
     194         CALL iom_put( "taubot", z2d )            
     195      ENDIF 
     196          
     197      CALL iom_put( "uoce", un(:,:,:)         )    ! 3D i-current 
     198      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
     199      IF ( iom_use("sbu") ) THEN 
     200         DO jj = 1, jpj 
     201            DO ji = 1, jpi 
     202               jkbot = mbku(ji,jj) 
     203               z2d(ji,jj) = un(ji,jj,jkbot) 
     204            END DO 
     205         END DO 
     206         CALL iom_put( "sbu", z2d )                ! bottom i-current 
     207      ENDIF 
     208#if defined key_dynspg_ts 
     209      CALL iom_put(  "ubar", un_adv(:,:)      )    ! barotropic i-current 
     210#else 
     211      CALL iom_put(  "ubar", un_b(:,:)        )    ! barotropic i-current 
     212#endif 
     213       
     214      CALL iom_put( "voce", vn(:,:,:)         )    ! 3D j-current 
     215      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
     216      IF ( iom_use("sbv") ) THEN 
     217         DO jj = 1, jpj 
     218            DO ji = 1, jpi 
     219               jkbot = mbkv(ji,jj) 
     220               z2d(ji,jj) = vn(ji,jj,jkbot) 
     221            END DO 
     222         END DO 
     223         CALL iom_put( "sbv", z2d )                ! bottom j-current 
     224      ENDIF 
     225#if defined key_dynspg_ts 
     226      CALL iom_put(  "vbar", vn_adv(:,:)      )    ! barotropic j-current 
     227#else 
     228      CALL iom_put(  "vbar", vn_b(:,:)        )    ! barotropic j-current 
     229#endif 
     230 
     231      CALL iom_put( "woce", wn )                   ! vertical velocity 
     232      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
     233         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
     234         z2d(:,:) = rau0 * e12t(:,:) 
     235         DO jk = 1, jpk 
     236            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     237         END DO 
     238         CALL iom_put( "w_masstr" , z3d )   
     239         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
     240      ENDIF 
     241 
     242      CALL iom_put( "avt" , avt                        )    ! T vert. eddy diff. coef. 
     243      CALL iom_put( "avm" , avmu                       )    ! T vert. eddy visc. coef. 
     244      CALL iom_put( "avs" , fsavs(:,:,:)               )    ! S vert. eddy diff. coef. (useful only with key_zdfddm) 
     245 
     246      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
     247         DO jj = 2, jpjm1                                    ! sst gradient 
     248            DO ji = fs_2, fs_jpim1   ! vector opt. 
     249               zztmp      = tsn(ji,jj,1,jp_tem) 
     250               zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
     251               zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
     252               z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
     253                  &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
     254            END DO 
     255         END DO 
     256         CALL lbc_lnk( z2d, 'T', 1. ) 
     257         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
     258         z2d(:,:) = SQRT( z2d(:,:) ) 
     259         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
     260      ENDIF 
     261          
     262      ! clem: heat and salt content 
     263      IF( iom_use("heatc") ) THEN 
     264         z2d(:,:)  = 0._wp  
     265         DO jk = 1, jpkm1 
     266            DO jj = 1, jpj 
     267               DO ji = 1, jpi 
     268                  z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     269               END DO 
     270            END DO 
     271         END DO 
     272         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2) 
     273      ENDIF 
     274 
     275      IF( iom_use("saltc") ) THEN 
     276         z2d(:,:)  = 0._wp  
     277         DO jk = 1, jpkm1 
     278            DO jj = 1, jpj 
     279               DO ji = 1, jpi 
     280                  z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     281               END DO 
     282            END DO 
     283         END DO 
     284         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2) 
     285      ENDIF 
     286      ! 
     287      IF ( iom_use("eken") ) THEN 
     288         rke(:,:,jk) = 0._wp                               !      kinetic energy  
     289         DO jk = 1, jpkm1 
     290            DO jj = 2, jpjm1 
     291               DO ji = fs_2, fs_jpim1   ! vector opt. 
     292                  zztmp   = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     293                  zztmpx  = 0.5 * (  un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    & 
     294                     &             + un(ji  ,jj,jk) * un(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk) )  & 
     295                     &          *  zztmp  
     296                  ! 
     297                  zztmpy  = 0.5 * (  vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)    & 
     298                     &             + vn(ji,jj  ,jk) * vn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) )  & 
     299                     &          *  zztmp  
     300                  ! 
     301                  rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 
     302                  ! 
     303               ENDDO 
     304            ENDDO 
     305         ENDDO 
     306         CALL lbc_lnk( rke, 'T', 1. ) 
     307         CALL iom_put( "eken", rke )            
     308      ENDIF 
     309          
     310      IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    196311         z3d(:,:,jpk) = 0.e0 
    197312         DO jk = 1, jpkm1 
    198             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) 
     313            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
    199314         END DO 
    200315         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
    201          zztmp = 0.5 * rcp 
     316      ENDIF 
     317       
     318      IF( iom_use("u_heattr") ) THEN 
    202319         z2d(:,:) = 0.e0  
    203320         DO jk = 1, jpkm1 
    204321            DO jj = 2, jpjm1 
    205322               DO ji = fs_2, fs_jpim1   ! vector opt. 
    206                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     323                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    207324               END DO 
    208325            END DO 
    209326         END DO 
    210327         CALL lbc_lnk( z2d, 'U', -1. ) 
    211          CALL iom_put( "u_heattr", z2d )                  ! heat transport in i-direction 
    212          DO jk = 1, jpkm1 
    213             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) 
    214          END DO 
    215          CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
     328         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction 
     329      ENDIF 
     330 
     331      IF( iom_use("u_salttr") ) THEN 
    216332         z2d(:,:) = 0.e0  
    217333         DO jk = 1, jpkm1 
    218334            DO jj = 2, jpjm1 
    219335               DO ji = fs_2, fs_jpim1   ! vector opt. 
    220                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     336                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    221337               END DO 
    222338            END DO 
    223339         END DO 
     340         CALL lbc_lnk( z2d, 'U', -1. ) 
     341         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction 
     342      ENDIF 
     343 
     344       
     345      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
     346         z3d(:,:,jpk) = 0.e0 
     347         DO jk = 1, jpkm1 
     348            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     349         END DO 
     350         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
     351      ENDIF 
     352       
     353      IF( iom_use("v_heattr") ) THEN 
     354         z2d(:,:) = 0.e0  
     355         DO jk = 1, jpkm1 
     356            DO jj = 2, jpjm1 
     357               DO ji = fs_2, fs_jpim1   ! vector opt. 
     358                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
     359               END DO 
     360            END DO 
     361         END DO 
    224362         CALL lbc_lnk( z2d, 'V', -1. ) 
    225          CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction 
     363         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction 
     364      ENDIF 
     365 
     366      IF( iom_use("v_salttr") ) THEN 
     367         z2d(:,:) = 0.e0  
     368         DO jk = 1, jpkm1 
     369            DO jj = 2, jpjm1 
     370               DO ji = fs_2, fs_jpim1   ! vector opt. 
     371                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
     372               END DO 
     373            END DO 
     374         END DO 
     375         CALL lbc_lnk( z2d, 'V', -1. ) 
     376         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    226377      ENDIF 
    227378      ! 
     
    489640         ENDIF 
    490641 
    491 #if ! defined key_coupled  
    492          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    493             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    494          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    495             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    496          CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    497             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    498 #endif 
    499  
    500  
    501  
    502 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    503          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    504             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    505          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    506             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    507          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    508             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    509 #endif 
     642         IF( .NOT. ln_cpl ) THEN 
     643            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     644               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     645            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     646               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     647            CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
     648               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     649         ENDIF 
     650 
     651         IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
     652            CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
     653               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     654            CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
     655               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     656            CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
     657               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     658         ENDIF 
     659          
    510660         clmx ="l_max(only(x))"    ! max index on a period 
    511661         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
     
    522672#endif 
    523673 
    524 #if defined key_coupled  
    525 # if defined key_lim3 
    526          Must be adapted to LIM3 
    527 # endif  
    528 # if defined key_lim2 
    529          CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
    530             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    531          CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
    532             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    533 # endif  
    534 #endif  
     674         IF( ln_cpl .AND. nn_ice == 2 ) THEN 
     675            CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice 
     676               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     677            CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice 
     678               &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     679         ENDIF 
    535680 
    536681         CALL histend( nid_T, snc4chunks=snc4set ) 
     
    623768      ENDIF 
    624769 
    625       ! Write fields on T grid 
    626770      IF( lk_vvl ) THEN 
    627771         CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T  )   ! heat content 
     
    634778         CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) , ndim_hT, ndex_hT )   ! sea surface temperature 
    635779         CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT )   ! sea surface salinity 
    636  
    637780      ENDIF 
    638781      IF( lk_vvl ) THEN 
     
    684827      ENDIF 
    685828 
    686 #if ! defined key_coupled 
    687       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    688       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    689       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    690       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    691 #endif 
    692 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    693       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    694       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     829      IF( .NOT. ln_cpl ) THEN 
     830         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     831         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    695832         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    696       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    697 #endif 
    698       zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    699       CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
     833         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     834      ENDIF 
     835      IF( ln_cpl .AND. nn_ice <= 1 ) THEN 
     836         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
     837         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
     838         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     839         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
     840      ENDIF 
     841!      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
     842!      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
    700843 
    701844#if defined key_diahth 
     
    706849#endif 
    707850 
    708 #if defined key_coupled  
    709 # if defined key_lim3 
    710       Must be adapted for LIM3 
    711       CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature 
    712       CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo 
    713 # endif 
    714 # if defined key_lim2 
    715       CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
    716       CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
    717 # endif 
    718 #endif 
    719          ! Write fields on U grid 
     851      IF( ln_cpl .AND. nn_ice == 2 ) THEN 
     852         CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT )   ! surf. ice temperature 
     853         CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT )   ! ice albedo 
     854      ENDIF 
     855 
    720856      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current 
    721857      IF( ln_traldf_gdia ) THEN 
     
    739875      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress 
    740876 
    741          ! Write fields on V grid 
    742877      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current 
    743878      IF( ln_traldf_gdia ) THEN 
     
    754889      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress 
    755890 
    756          ! Write fields on W grid 
    757891      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current 
    758892      IF( ln_traldf_gdia ) THEN 
Note: See TracChangeset for help on using the changeset viewer.