Changeset 3690


Ignore:
Timestamp:
2012-11-27T17:51:05+01:00 (8 years ago)
Author:
gm
Message:

trunk: #860 : Unallocated arrays qrp and erp sometimes passed from dia_wri: fixed

Location:
trunk/NEMOGCM/NEMO/OPA_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r3643 r3690  
    401401         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    402402            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    403 #if ! defined key_coupled  
    404          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    405             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    406          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    407             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    408          CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn 
    409             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    410 #endif 
    411  
    412  
    413  
    414 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    415          CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp 
    416             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    417          CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp 
    418             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    419          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn 
    420             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    421 #endif 
     403         IF( ln_ssr ) THEN 
     404            IF( nn_sstr /= 0 ) THEN 
     405               CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping", "W/m2"      ,   &  ! qrp 
     406                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     407            ENDIF 
     408            IF( nn_sssr /= 0 ) THEN 
     409               CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"  , "Kg/m2/s",   &  ! erp 
     410                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     411               CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"   , "Kg/m2/s",   &  ! erp * sn 
     412                  &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     413            ENDIF 
     414         ENDIF 
    422415         clmx ="l_max(only(x))"    ! max index on a period 
    423416         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX  
    424417            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout ) 
    425418#if defined key_diahth 
    426          CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth 
    427             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    428          CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20 
    429             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    430          CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28 
    431             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    432          CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3 
     419         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   &  ! hth 
     420            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     421         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   &  ! hd20 
     422            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     423         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   &  ! hd28 
     424            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     425         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   &  ! htc3 
    433426            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    434427#endif 
     
    555548      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    556549      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
    557 #if ! defined key_coupled 
    558       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    559       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    560       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    561       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    562 #endif 
    563 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )  
    564       CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    565       CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    566          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    567       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    568 #endif 
     550      IF( ln_ssr ) THEN 
     551         IF( nn_sstr /= 0 ) THEN 
     552            CALL histwrite( nid_T, "sohefldp", it, qrp     , ndim_hT, ndex_hT )   ! heat flux damping 
     553         ENDIF 
     554         IF( nn_sssr /= 0 ) THEN 
     555            CALL histwrite( nid_T, "sowafldp", it, erp     , ndim_hT, ndex_hT )   ! freshwater flux damping 
     556            zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     557            CALL histwrite( nid_T, "sosafldp", it, zw2d    , ndim_hT, ndex_hT )   ! salt flux damping 
     558         ENDIF 
     559      ENDIF 
    569560      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 
    570561      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ??? 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r3294 r3690  
    164164       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)  
    165165       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:) 
    166        fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) 
    167        fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) 
     166       IF( ln_ssr ) THEN 
     167          IF( nn_sstr /= 0 )   fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) 
     168          IF( nn_sssr /= 0 )   fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) 
     169       ENDIF 
    168170       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:) 
    169171       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:) 
     
    232234          fsel(:,:,6 ) = sshn(:,:) 
    233235          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1) 
    234           fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1) 
    235           fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1) 
     236          IF( ln_ssr ) THEN 
     237             IF( nn_sstr /= 0 )   fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1) 
     238             IF( nn_sssr /= 0 )   fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1) 
     239          ENDIF 
    236240          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1) 
    237241          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r3421 r3690  
    199199         IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation' 
    200200      ENDIF 
    201  
    202       IF( nn_ice == 4 )   CALL cice_sbc_init (nsbc) 
     201      ! 
     202      IF( ln_ssr      )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     203      ! 
     204      IF( nn_ice == 4 )   CALL cice_sbc_init( nsbc )      ! CICE initialisation 
    203205      ! 
    204206   END SUBROUTINE sbc_init 
     
    367369   END SUBROUTINE sbc 
    368370 
     371 
    369372   SUBROUTINE sbc_final 
    370373      !!--------------------------------------------------------------------- 
    371374      !!                    ***  ROUTINE sbc_final  *** 
    372       !!--------------------------------------------------------------------- 
    373  
    374       !----------------------------------------------------------------- 
    375       ! Finalize CICE (if used) 
    376       !----------------------------------------------------------------- 
    377  
     375      !! 
     376      !! ** Purpose :   Finalize CICE (if used) 
     377      !!--------------------------------------------------------------------- 
     378      ! 
    378379      IF( nn_ice == 4 )   CALL cice_sbc_final 
    379380      ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r3558 r3690  
    2727   PRIVATE 
    2828 
    29    PUBLIC   sbc_ssr    ! routine called in sbcmod 
     29   PUBLIC   sbc_ssr        ! routine called in sbcmod 
     30   PUBLIC   sbc_ssr_init   ! routine called in sbcmod 
    3031 
    3132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s] 
     
    8384      IF( nn_timing == 1 )  CALL timing_start('sbc_ssr') 
    8485      ! 
    85       !                                               ! -------------------- ! 
    86       IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
    87          !                                            ! -------------------- ! 
    88          !                            !* set file information 
    89          cn_dir  = './'            ! directory in which the model is executed 
    90          ! ... default values (NB: frequency positive => hours, negative => months) 
    91          !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    92          !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    93          sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
    94          sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
    95  
    96          REWIND ( numnam )            !* read in namlist namflx 
    97          READ( numnam, namsbc_ssr )  
    98  
    99          IF(lwp) THEN                 !* control print 
    100             WRITE(numout,*) 
    101             WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
    102             WRITE(numout,*) '~~~~~~~ ' 
    103             WRITE(numout,*) '   Namelist namsbc_ssr :' 
    104             WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
    105             WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
    106             WRITE(numout,*) '                       (Yes=2, volume flux) ' 
    107             WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
    108             WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
    109             WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    110             WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
    111          ENDIF 
    112  
    113          ! Allocate erp and qrp array 
    114          ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 
    115          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
    116  
    117          IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays 
    118             ! 
    119             ALLOCATE( sf_sst(1), STAT=ierror ) 
    120             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' ) 
    121             ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) 
    122             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' ) 
    123             ! 
    124             ! fill sf_sst with sn_sst and control print 
    125             CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
    126             IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    127             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 
    128             ! 
    129          ENDIF 
    130          ! 
    131          IF( nn_sssr >= 1 ) THEN      ! set sf_sss structure & allocate arrays 
    132             ! 
    133             ALLOCATE( sf_sss(1), STAT=ierror ) 
    134             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 
    135             ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 
    136             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 
    137             ! 
    138             ! fill sf_sss with sn_sss and control print 
    139             CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
    140             IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    141             IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 
    142             ! 
    143          ENDIF 
    144          ! 
    145          ! Initialize qrp and erp if no restoring  
    146          IF( nn_sstr /= 1                   )   qrp(:,:) = 0.e0  
    147          IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0.e0  
    148       ENDIF 
    149  
    15086      IF( nn_sstr + nn_sssr /= 0 ) THEN 
    15187         ! 
     
    208144      ! 
    209145   END SUBROUTINE sbc_ssr 
     146 
     147  
     148   SUBROUTINE sbc_ssr_init 
     149      !!--------------------------------------------------------------------- 
     150      !!                  ***  ROUTINE sbc_ssr_init  *** 
     151      !! 
     152      !! ** Purpose :   initialisation of surface damping term 
     153      !! 
     154      !! ** Method  : - Read namelist namsbc_ssr 
     155      !!              - Read observed SST and/or SSS if required 
     156      !!--------------------------------------------------------------------- 
     157      INTEGER  ::   ji, jj   ! dummy loop indices 
     158      REAL(wp) ::   zerp     ! local scalar for evaporation damping 
     159      REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
     160      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
     161      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
     162      INTEGER  ::   ierror   ! return error code 
     163      !! 
     164      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     165      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
     166      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     167      !!---------------------------------------------------------------------- 
     168      ! 
     169      !                            !* set file information 
     170      cn_dir  = './'            ! directory in which the model is executed 
     171      ! ... default values (NB: frequency positive => hours, negative => months) 
     172      !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     173      !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     174      sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
     175      sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
     176 
     177      REWIND( numnam )             !* read in namlist namflx 
     178      READ  ( numnam, namsbc_ssr )  
     179 
     180      IF(lwp) THEN                 !* control print 
     181         WRITE(numout,*) 
     182         WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
     183         WRITE(numout,*) '~~~~~~~ ' 
     184         WRITE(numout,*) '   Namelist namsbc_ssr :' 
     185         WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
     186         WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
     187         WRITE(numout,*) '                       (Yes=2, volume flux) ' 
     188         WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
     189         WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
     190         WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
     191         WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
     192      ENDIF 
     193      ! 
     194      !                            !* Allocate erp and qrp array 
     195      ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 
     196      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
     197      ! 
     198      IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays 
     199         ! 
     200         ALLOCATE( sf_sst(1), STAT=ierror ) 
     201         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' ) 
     202         ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) 
     203         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' ) 
     204         ! 
     205         ! fill sf_sst with sn_sst and control print 
     206         CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
     207         IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
     208         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 
     209         ! 
     210      ENDIF 
     211      ! 
     212      IF( nn_sssr >= 1 ) THEN      !* set sf_sss structure & allocate arrays 
     213         ! 
     214         ALLOCATE( sf_sss(1), STAT=ierror ) 
     215         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 
     216         ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 
     217         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 
     218         ! 
     219         ! fill sf_sss with sn_sss and control print 
     220         CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
     221         IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
     222         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 
     223         ! 
     224      ENDIF 
     225      ! 
     226      !                            !* Initialize qrp and erp if no restoring  
     227      IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp 
     228      IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp 
     229      ! 
     230   END SUBROUTINE sbc_ssr_init 
    210231       
    211232   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.