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 84 – NEMO

Changeset 84


Ignore:
Timestamp:
2004-04-22T15:32:41+02:00 (20 years ago)
Author:
opalod
Message:

CT : UPDATE057 : # General syntax, alignement, comments corrections

# l_ctl alone replace the set (l_ctl .AND. lwp)
# Add of diagnostics which are activated when using l_ctl logical

Location:
trunk/NEMO/OPA_SRC
Files:
21 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/DIA/diafwb.F90

    r32 r84  
    109109      IF( lk_mpp )   CALL mpp_sum( a_rnf    )       ! sum over the global domain 
    110110 
    111       IF( aminus /= 0.0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 
    112       IF( aplus  /= 0.0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  ) 
     111      IF( aminus /= 0.e0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 
     112      IF( aplus  /= 0.e0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  ) 
    113113 
    114114      IF( kt == nitend ) THEN 
     
    205205         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    206206 
    207          IF( un(ji,jj,jk) > 0.0 ) THEN  
     207         IF( un(ji,jj,jk) > 0.e0 ) THEN  
    208208            zflxi(1) = zflxi(1) +    zu 
    209209            ztemi(1) = ztemi(1) + zt*zu 
     
    245245         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    246246          
    247          IF( un(ji,jj,jk) > 0.0 ) THEN  
     247         IF( un(ji,jj,jk) > 0.e0 ) THEN  
    248248            zflxi(2) = zflxi(2) +    zu 
    249249            ztemi(2) = ztemi(2) + zt*zu 
     
    285285         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    286286          
    287          IF( un(ji,jj,jk) > 0.0 ) THEN  
     287         IF( un(ji,jj,jk) > 0.e0 ) THEN  
    288288            zflxi(3) = zflxi(3) +    zu 
    289289            ztemi(3) = ztemi(3) + zt*zu 
     
    325325         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    326326          
    327          IF( un(ji,jj,jk) > 0.0 ) THEN  
     327         IF( un(ji,jj,jk) > 0.e0 ) THEN  
    328328            zflxi(4) = zflxi(4) +    zu 
    329329            ztemi(4) = ztemi(4) + zt*zu 
     
    338338      ! Sum at each time-step 
    339339      DO jt = 1, 4  
    340          IF( zflxi(jt) /= 0.0 .AND. zflxo(jt) /= 0.0 ) THEN 
     340         IF( zflxi(jt) /= 0.e0 .AND. zflxo(jt) /= 0.e0 ) THEN 
    341341            a_flxi(jt) = a_flxi(jt) + zflxi(jt) 
    342342            a_temi(jt) = a_temi(jt) + ztemi(jt)/zflxi(jt) 
     
    350350      IF( kt == nitend ) THEN 
    351351         DO jt = 1, 4  
    352             a_flxi(jt) = a_flxi(jt)/((nitend-nit000+1)*1.e6) 
    353             a_temi(jt) = a_temi(jt)/( nitend-nit000+1) 
    354             a_sali(jt) = a_sali(jt)/( nitend-nit000+1) 
    355             a_flxo(jt) = a_flxo(jt)/((nitend-nit000+1)*1.e6) 
    356             a_temo(jt) = a_temo(jt)/( nitend-nit000+1) 
    357             a_salo(jt) = a_salo(jt)/( nitend-nit000+1) 
     352            a_flxi(jt) = a_flxi(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 ) 
     353            a_temi(jt) = a_temi(jt) /   FLOAT( nitend - nit000 + 1 ) 
     354            a_sali(jt) = a_sali(jt) /   FLOAT( nitend - nit000 + 1 ) 
     355            a_flxo(jt) = a_flxo(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 ) 
     356            a_temo(jt) = a_temo(jt) /   FLOAT( nitend - nit000 + 1 ) 
     357            a_salo(jt) = a_salo(jt) /   FLOAT( nitend - nit000 + 1 ) 
    358358         END DO 
    359359      ENDIF 
     
    368368         WRITE(111,*) 
    369369         WRITE(111,*)    'Net freshwater budget ' 
    370          WRITE(111,9010) '  emp    = ',a_emp,   ' m3 =', a_emp   /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
    371          WRITE(111,9010) '  precip = ',a_precip,' m3 =', a_precip/((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
    372          WRITE(111,9010) '  a_rnf   = ',a_rnf,   ' m3 =', a_rnf   /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
     370         WRITE(111,9010) '  emp    = ',a_emp,   ' m3 =', a_emp   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
     371         WRITE(111,9010) '  precip = ',a_precip,' m3 =', a_precip/(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
     372         WRITE(111,9010) '  a_rnf  = ',a_rnf,   ' m3 =', a_rnf   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv' 
    373373         WRITE(111,*) 
    374374         WRITE(111,9010) '  zarea =',zarea 
     
    378378         WRITE(111,9010) '  at nit000 = ',a_sshb        ,' m3 ' 
    379379         WRITE(111,9010) '  at nitend = ',a_sshn        ,' m3 ' 
    380          WRITE(111,9010) '  diff      = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/((nitend-nit000+1)*rdt) * 1.e-6,' Sv' 
     380         WRITE(111,9010) '  diff      = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv' 
    381381         WRITE(111,9020) '  mean sea level elevation    =', a_sshn/zarea,' m' 
    382382         WRITE(111,*) 
  • trunk/NEMO/OPA_SRC/DIA/diawri.F90

    r23 r84  
    364364            CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs 
    365365               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    366             CALL histdef( nid_W,"voddmrra","Heat/Salt buoyancy Ratio"          , "-"      ,   &  ! rrau 
    367                &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 
    368366         ENDIF 
    369367         !                                                                                      !!! nid_W : 2D 
  • trunk/NEMO/OPA_SRC/DOM/domwri.F90

    r3 r84  
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!   dom_wri        : create mesh and mask file (s) 
     8   !!   dom_wri        : create and write mesh and mask file(s) 
    99   !!                    nmsh = 1  :   mesh_mask file 
    1010   !!                         = 2  :   mesh and mask file 
  • trunk/NEMO/OPA_SRC/DTA/dtasst.F90

    r16 r84  
    9696         IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data' 
    9797         IF(lwp) WRITE(numout,*) '~~~~~~~   read in file: ', clname 
     98         sst(:,:) = 0.e0   ! required for extra halos in mpp 
    9899      ENDIF 
    99100 
  • trunk/NEMO/OPA_SRC/DYN/dynhpg.F90

    r32 r84  
    162162      END DO 
    163163 
    164       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     164      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    165165         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    166166         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     
    317317      END DO 
    318318 
    319       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     319      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    320320         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    321321         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     
    428428      END DO 
    429429 
    430       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     430      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    431431         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    432432         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynhpg_atsk.F90

    r32 r84  
    150150      !                                                ! =============== 
    151151 
    152       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     152      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    153153         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    154154         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     
    295295      END DO                                           !   End of slab 
    296296      !                                                ! =============== 
     297 
     298      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
     299         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     300         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     301         WRITE(numout,*) ' hpg  - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl 
     302         u_ctl = zuap   ;   v_ctl = zvap 
     303      ENDIF    
     304 
    297305   END SUBROUTINE dyn_hpg_atsk 
    298306 
     
    402410      !                                                ! =============== 
    403411 
    404       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     412      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    405413         WRITE(numout,*) ' hpg  - Ua: ', SUM(ua*umask), ' Va: ', SUM(va*vmask) 
    406414         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynkeg.F90

    r3 r84  
    119119      !                                                ! =============== 
    120120 
    121       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     121      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    122122         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    123123         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r3 r84  
    219219      END DO                                           !   End of slab 
    220220      !                                                ! =============== 
     221 
     222      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
     223         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     224         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     225         WRITE(numout,*) ' ldf  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 
     226         u_ctl = zua   ;   v_ctl = zva 
     227      ENDIF 
     228 
    221229   END SUBROUTINE dyn_ldf_bilap 
    222230 
  • trunk/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r32 r84  
    7373      !! * Local declarations 
    7474      INTEGER ::   ji, jj, jk                 ! dummy loop indices 
     75      REAL(wp) ::   zua, zva                  ! temporary scalars 
    7576      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    7677         wk1, wk2,            &  ! work array used for rotated biharmonic 
     
    126127      END DO                                           !   End of slab 
    127128      !                                                ! =============== 
     129 
     130      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
     131         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     132         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     133         WRITE(numout,*) ' ldf  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 
     134         u_ctl = zua   ;   v_ctl = zva 
     135      ENDIF 
    128136 
    129137   END SUBROUTINE dyn_ldf_bilapg 
  • trunk/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r3 r84  
    118118      !                                                ! =============== 
    119119 
    120       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     120      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    121121         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    122122         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynnxt.F90

    r32 r84  
    133133      !                                                ! =============== 
    134134 
    135       IF( l_ctl .AND. lwp ) THEN         ! print sum fields (used for debugging) 
    136          WRITE(numout,*) ' nxt  - Un: ', SUM(un*umask), ' Vn: ', SUM(vn*vmask) 
    137       ENDIF 
     135      IF(l_ctl)   WRITE(numout,*) ' nxt  - Un: ', SUM(un*umask), ' Vn: ', SUM(vn*vmask) 
    138136 
    139137   END SUBROUTINE dyn_nxt 
  • trunk/NEMO/OPA_SRC/DYN/dynspg_fsc.F90

    r31 r84  
    347347      END DO 
    348348 
    349       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     349      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    350350         WRITE(numout,*) ' spg  - Ua: ', SUM( ua(2:jpim1,2:jpjm1,1:jpkm1)*umask(2:jpim1,2:jpjm1,1:jpkm1) ),   & 
    351351            &                   ' Va: ', SUM( va(2:jpim1,2:jpjm1,1:jpkm1)*vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynspg_fsc_atsk.F90

    r31 r84  
    1818   USE oce             ! ocean dynamics and tracers  
    1919   USE dom_oce         ! ocean space and time domain 
    20    USE trdtra_oce     ! ocean active tracer trend  
    21    USE trddyn_oce     ! ocean dynamics trend 
     20   USE zdf_oce         ! ocean vertical physics 
     21   USE trdtra_oce      ! ocean active tracer trend  
     22   USE trddyn_oce      ! ocean dynamics trend 
    2223   USE in_out_manager  ! I/O manager 
    2324   USE phycst          ! physical constant 
    24    USE ocesbc          ! Ocen Surface Boundary condition 
     25   USE ocesbc          ! Ocean Surface Boundary condition 
    2526   USE flxrnf          ! ??? 
    2627   USE sol_oce         ! ocean elliptic solver 
     
    3031   USE obc_oce         ! Lateral open boundary condition 
    3132   USE obcdyn          ! open boudary condition 
    32    USE obcdyn          !    "              " 
    3333   USE obcvol          !    "              " 
    3434   USE lib_mpp         ! ??? 
     
    362362         END DO 
    363363 
     364         IF(l_ctl) THEN         ! print sum trends (used for debugging) 
     365            WRITE(numout,*) ' spg  - Ua: ', SUM( ua(2:jpim1,2:jpjm1,1:jpkm1)*umask(2:jpim1,2:jpjm1,1:jpkm1) ),   & 
     366               &                   ' Va: ', SUM( va(2:jpim1,2:jpjm1,1:jpkm1)*vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     367         ENDIF 
     368 
    364369         ! 8. Sea surface elevation time stepping 
    365370         ! -------------------------------------- 
  • trunk/NEMO/OPA_SRC/DYN/dynzad.F90

    r3 r84  
    126126      !                                                ! =============== 
    127127 
    128       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     128      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    129129         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    130130         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     
    227227      END DO 
    228228 
    229       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     229      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    230230         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    231231         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r3 r84  
    342342      END DO 
    343343 
    344       IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging) 
     344      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
    345345         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
    346346         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
  • trunk/NEMO/OPA_SRC/DYN/dynzdf_imp_atsk.F90

    r3 r84  
    312312      END DO                                           !   End of slab 
    313313      !                                                ! =============== 
     314 
     315      IF(l_ctl) THEN         ! print sum trends (used for debugging) 
     316         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     317         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) ) 
     318         WRITE(numout,*) ' zdf  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl 
     319         u_ctl = zua   ;   v_ctl = zva 
     320      ENDIF 
     321 
    314322   END SUBROUTINE dyn_zdf_imp_tsk 
    315323 
  • trunk/NEMO/OPA_SRC/FLO/floblk.F90

    r16 r84  
    348348# if defined key_obc 
    349349      DO jfl = 1, jpnfl 
    350          IF( lpeastobc ) THEN 
     350         IF( lp_obc_east ) THEN 
    351351            IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN 
    352352               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     
    355355            END IF 
    356356         END IF 
    357          IF( lpwestobc ) THEN 
     357         IF( lp_obc_west ) THEN 
    358358            IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN 
    359359               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     
    362362            END IF 
    363363         END IF 
    364          IF( lpnorthobc ) THEN 
     364         IF( lp_obc_north ) THEN 
    365365            IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN 
    366366               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     
    369369            END IF 
    370370         END IF 
    371          IF( lpsouthobc ) THEN 
     371         IF( lp_obc_south ) THEN 
    372372            IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN 
    373373               zgifl (jfl) = INT(zgifl(jfl)) + 0.5 
     
    408408      ENDIF 
    409409 
    410       RETURN 
    411410   END SUBROUTINE flo_blk 
    412411 
  • trunk/NEMO/OPA_SRC/SBC/bulk.F90

    r17 r84  
    9595 
    9696# if ! defined key_ice_lim 
    97          IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging) 
     97         IF(l_ctl) THEN         ! print mean trends (used for debugging) 
    9898            WRITE(numout,*) ' Forcings ' 
    9999            WRITE(numout,*) ' qsr_oce  : ', SUM( qsr_oce (:,:) * tmask(:,:,1) ) 
  • trunk/NEMO/OPA_SRC/SBC/flxblk.F90

    r18 r84  
    3333 
    3434   !! * Module variables 
    35       INTEGER, PARAMETER  ::   & 
    36          jpintsr = 24          ! number of time step between sunrise and sunset 
    37          !                     ! uses for heat flux computation 
    38       LOGICAL ::   & 
    39          lbulk_init = .TRUE.   ! flag, bulk initialization done or not) 
    40  
    41       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    42          stauc            ,  &   ! cloud optical depth  
    43          sbudyko    
    44  
    45       !! * constants for bulk computation (flx_blk) 
    46       REAL(wp), DIMENSION(19)  ::  & 
    47          budyko                  ! BUDYKO's coefficient 
    48       ! BUDYKO's coefficient (cloudiness effect on LW radiation): 
    49       DATA budyko / 1.00, 0.98, 0.95, 0.92, 0.89, 0.86, 0.83, 0.80, 0.78, 0.75,  & 
    50                     0.72, 0.69, 0.67, 0.64, 0.61, 0.58, 0.56, 0.53, 0.50 / 
    51       REAL(wp), DIMENSION(20)  :: & 
    52          tauco                  ! cloud optical depth coefficient 
    53       ! Cloud optical depth coefficient 
    54       DATA tauco / 6.6, 6.6, 7.0, 7.2, 7.1, 6.8, 6.5, 6.6, 7.1, 7.6,   & 
    55                    6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / 
    56       REAL(wp)  ::            &  ! constant values 
    57          zeps    = 1e-20   ,  & 
    58          zeps0   = 1e-13   ,  & 
    59          zeps1   = 1e-06   ,  & 
    60          zzero   = 0.0     ,  & 
    61          zone    = 1.0 
    62  
    63       !! * constants for albedo computation (flx_blk_albedo) 
    64       REAL(wp) ::   & 
    65          c1     = 0.05  ,     &   ! constants values 
    66          c2     = 0.1   ,     & 
    67          albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    68          cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
    69                                   !  effects of cloudiness (Grenfell & Perovich, 1984) 
    70          alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute 
    71          alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972) 
    72          alphc  = 0.65  ,     & 
    73          zmue   = 0.4             !  cosine of local solar altitude 
    74  
    75       !! * constants for solar declinaison computation (flx_blk_declin) 
    76       REAL(wp) ::                & 
    77          a0  =  0.39507671   ,   &  ! coefficients 
    78          a1  = 22.85684301   ,   & 
    79          a2  = -0.38637317   ,   & 
    80          a3  =  0.15096535   ,   & 
    81          a4  = -0.00961411   ,   & 
    82          b1  = -4.29692073   ,   & 
    83          b2  =  0.05702074   ,   & 
    84          b3  = -0.09028607   ,   & 
    85          b4  =  0.00592797 
     35   INTEGER, PARAMETER  ::   & 
     36      jpintsr = 24          ! number of time step between sunrise and sunset 
     37      !                     ! uses for heat flux computation 
     38   LOGICAL ::   & 
     39      lbulk_init = .TRUE.   ! flag, bulk initialization done or not) 
     40 
     41   REAL(wp), DIMENSION(jpi,jpj) ::   & 
     42      stauc            ,  &   ! cloud optical depth  
     43      sbudyko    
     44 
     45   !! * constants for bulk computation (flx_blk) 
     46   REAL(wp), DIMENSION(19)  ::  & 
     47      budyko                  ! BUDYKO's coefficient 
     48   ! BUDYKO's coefficient (cloudiness effect on LW radiation): 
     49   DATA budyko / 1.00, 0.98, 0.95, 0.92, 0.89, 0.86, 0.83, 0.80, 0.78, 0.75,  & 
     50      &          0.72, 0.69, 0.67, 0.64, 0.61, 0.58, 0.56, 0.53, 0.50 / 
     51   REAL(wp), DIMENSION(20)  :: & 
     52      tauco                  ! cloud optical depth coefficient 
     53   ! Cloud optical depth coefficient 
     54   DATA tauco / 6.6, 6.6, 7.0, 7.2, 7.1, 6.8, 6.5, 6.6, 7.1, 7.6,   & 
     55      &         6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / 
     56   REAL(wp)  ::            &  ! constant values 
     57      zeps    = 1.e-20  ,  & 
     58      zeps0   = 1.e-13  ,  & 
     59      zeps1   = 1.e-06  ,  & 
     60      zzero   = 0.e0    ,  & 
     61      zone    = 1.0 
     62 
     63   !! * constants for albedo computation (flx_blk_albedo) 
     64   REAL(wp) ::   & 
     65      c1     = 0.05  ,     &   ! constants values 
     66      c2     = 0.10  ,     & 
     67      albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
     68      cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account 
     69                               !  effects of cloudiness (Grenfell & Perovich, 1984) 
     70      alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute 
     71      alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972) 
     72      alphc  = 0.65  ,     & 
     73      zmue   = 0.40            !  cosine of local solar altitude 
     74 
     75   !! * constants for solar declinaison computation (flx_blk_declin) 
     76   REAL(wp) ::                & 
     77      a0  =  0.39507671   ,   &  ! coefficients 
     78      a1  = 22.85684301   ,   & 
     79      a2  = -0.38637317   ,   & 
     80      a3  =  0.15096535   ,   & 
     81      a4  = -0.00961411   ,   & 
     82      b1  = -4.29692073   ,   & 
     83      b2  =  0.05702074   ,   & 
     84      b3  = -0.09028607   ,   & 
     85      b4  =  0.00592797 
    8686   !!---------------------------------------------------------------------- 
    8787   !!   OPA 9.0 , LODYC-IPSL  (2003) 
     
    237237         DO jj = 1, jpj   
    238238            DO ji = 1 , jpi 
    239             zalat          = ( 90.0 - ABS( gphit(ji,jj) ) ) / 5.0 
    240             zclat          = ( 95.0 -      gphit(ji,jj)   ) / 10.0 
    241             indxb          = 1 + INT( zalat )  
    242             !  correction factor to account for the effect of clouds  
    243             sbudyko(ji,jj) = budyko(indxb)   
    244             indxc          = 1 + INT( zclat )   
    245             zdl            = zclat - INT( zclat )  
    246             zdr            = 1.0 - zdl 
    247             stauc(ji,jj)   = zdr * tauco( indxc ) + zdl * tauco( indxc + 1 )  
     239               zalat          = ( 90.e0 - ABS( gphit(ji,jj) ) ) /  5.e0 
     240               zclat          = ( 95.e0 -      gphit(ji,jj)   ) / 10.e0 
     241               indxb          = 1 + INT( zalat )  
     242               !  correction factor to account for the effect of clouds  
     243               sbudyko(ji,jj) = budyko(indxb)   
     244               indxc          = 1 + INT( zclat )   
     245               zdl            = zclat - INT( zclat )  
     246               zdr            = 1.0 - zdl 
     247               stauc(ji,jj)   = zdr * tauco( indxc ) + zdl * tauco( indxc + 1 )  
    248248            END DO 
    249249         END DO 
    250250         IF( nleapy == 1 ) THEN 
    251             yearday = 366.0 
     251            yearday = 366.e0 
    252252         ELSE IF( nleapy == 0 ) THEN 
    253             yearday = 365.0 
     253            yearday = 365.e0 
    254254         ELSEIF( nleapy == 30) THEN 
    255             yearday = 360.0 
     255            yearday = 360.e0 
    256256         ENDIF 
    257257         lbulk_init = .FALSE. 
     
    265265      zqsb_ice(:,:) = 0.e0 
    266266 
    267       zpis2       = rpi / 2.              ! pi / 2 
    268       z2pi        = 2. * rpi              ! 2 * pi  
     267      zpis2       = rpi / 2. 
     268      z2pi        = 2. * rpi 
    269269 
    270270 !CDIR NOVERRCHK 
    271      DO jj = 1, jpj 
     271      DO jj = 1, jpj 
    272272 !CDIR NOVERRCHK 
    273         DO ji = 1, jpi 
    274  
    275       ztatm (ji,jj) = 273.15 + tatm  (ji,jj)  !  air temperature in Kelvins  
    276       zcatm1(ji,jj) = 1.0    - catm  (ji,jj)  !  fractional cloud cover 
    277       zfrld (ji,jj) = 1.0    - freeze(ji,jj)  !  fractional sea ice cover 
    278       zpatm(ji,jj)  = 101000.               !  pressure  
    279        
    280       !  Computation of air density, obtained from the equation of state for dry air.  
    281       zrhoa(ji,jj) = zpatm(ji,jj) / ( 287.04 * ztatm(ji,jj) ) 
    282        
    283       !  zes : Saturation water vapour 
     273         DO ji = 1, jpi 
     274 
     275            ztatm (ji,jj) = 273.15 + tatm  (ji,jj)  !  air temperature in Kelvins  
     276            zcatm1(ji,jj) = 1.0    - catm  (ji,jj)  !  fractional cloud cover 
     277            zfrld (ji,jj) = 1.0    - freeze(ji,jj)  !  fractional sea ice cover 
     278            zpatm(ji,jj)  = 101000.               !  pressure  
     279       
     280            !  Computation of air density, obtained from the equation of state for dry air.  
     281            zrhoa(ji,jj) = zpatm(ji,jj) / ( 287.04 * ztatm(ji,jj) ) 
     282       
     283            !  zes : Saturation water vapour 
    284284            ztamr = ztatm(ji,jj) - rtt 
    285285            zmt1  = SIGN( 17.269, ztamr ) 
     
    289289               &                      / ( ztatm(ji,jj) - 35.86  + MAX( zzero, zmt3 ) ) ) 
    290290 
    291       !  zev : vapour pressure  (hatm is relative humidity)   
    292       zev(ji,jj)   = hatm(ji,jj) * zes(ji,jj)  
    293       !  square-root of vapour pressure 
     291            !  zev : vapour pressure  (hatm is relative humidity)   
     292            zev(ji,jj)   = hatm(ji,jj) * zes(ji,jj)  
     293            !  square-root of vapour pressure 
    294294!CDIR NOVERRCHK 
    295       zevsqr(ji,jj) = SQRT( zev(ji,jj) * 0.01 ) 
    296       !  zqapb  : specific humidity  
    297       zqatm(ji,jj) = 0.622 * zev(ji,jj) / ( zpatm(ji,jj) - 0.378 * zev(ji,jj) ) 
    298  
    299  
    300       !---------------------------------------------------- 
    301       !   Computation of snow precipitation (Ledley, 1985) | 
    302       !---------------------------------------------------- 
     295            zevsqr(ji,jj) = SQRT( zev(ji,jj) * 0.01 ) 
     296            !  zqapb  : specific humidity  
     297            zqatm(ji,jj) = 0.622 * zev(ji,jj) / ( zpatm(ji,jj) - 0.378 * zev(ji,jj) ) 
     298 
     299 
     300            !---------------------------------------------------- 
     301            !   Computation of snow precipitation (Ledley, 1985) | 
     302            !---------------------------------------------------- 
    303303 
    304304            zmt1  =   253.0 - ztatm(ji,jj) 
     
    333333 
    334334      iday   = INT( zxday ) 
    335       IF( l_ctl .AND. lwp ) WRITE(numout,*) ' declin : iday ', iday, ' nfbulk= ', nfbulk 
     335      IF(l_ctl)  WRITE(numout,*) ' declin : iday ', iday, ' nfbulk= ', nfbulk 
    336336      !   computation of the solar declination, his sine and his cosine 
    337337      CALL flx_blk_declin( indaet, iday, zdecl ) 
     
    351351         DO ji = 1, jpi 
    352352            !  product of sine of latitude and sine of solar declination 
    353             zps(ji,jj)    = SIN( gphit(ji,jj) * rad ) * zsdecl 
     353            zps     (ji,jj) = SIN( gphit(ji,jj) * rad ) * zsdecl 
    354354            !  product of cosine of latitude and cosine of solar declination 
    355             zpc(ji,jj)    = COS( gphit(ji,jj) * rad ) * zcdecl 
     355            zpc     (ji,jj) = COS( gphit(ji,jj) * rad ) * zcdecl 
    356356            !  computation of the both local time of sunrise and sunset 
    357             zlsrise(ji,jj) = ACOS( - SIGN( zone, zps(ji,jj) ) * MIN( zone, SIGN( zone, zps(ji,jj) )  & 
     357            zlsrise (ji,jj) = ACOS( - SIGN( zone, zps(ji,jj) ) * MIN( zone, SIGN( zone, zps(ji,jj) )  & 
    358358               &                     * ( zps(ji,jj) / zpc(ji,jj) ) ) )  
    359             zlsset(ji,jj) = - zlsrise(ji,jj) 
     359            zlsset  (ji,jj) = - zlsrise(ji,jj) 
    360360            !  dividing the solar day into jpintsr segments of length zdlha 
    361             zdlha(ji,jj)   = ( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jpintsr ) 
     361            zdlha   (ji,jj) = ( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jpintsr ) 
    362362            !  computation of the local noon solar altitude 
    363             zlmunoon(ji,jj)= ASIN ( ( zps(ji,jj) + zpc(ji,jj) ) ) / rad 
     363            zlmunoon(ji,jj) = ASIN ( ( zps(ji,jj) + zpc(ji,jj) ) ) / rad 
    364364             
    365365            !  cloud correction taken from Reed (1977) (imposed lower than 1) 
    366             zcldcor(ji,jj) = MIN( zone, ( 1 - 0.62 * catm(ji,jj) + 0.0019 * zlmunoon(ji,jj) ) ) 
     366            zcldcor (ji,jj) = MIN( zone, ( 1.e0 - 0.62 * catm(ji,jj) + 0.0019 * zlmunoon(ji,jj) ) ) 
    367367         END DO 
    368368      END DO 
     
    380380            DO ji = 1, jpi 
    381381               !  local hour angle 
    382                zlha (ji,jj,jt)= COS ( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) 
     382               zlha (ji,jj,jt) = COS ( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) ) 
    383383 
    384384               ! cosine of local solar altitude 
     
    417417      !-------------------------------------------------------------------- 
    418418 
    419       zalbocsd(:,:) = 0.   
    420       zqsro   (:,:) = 0. 
    421       zqsrics (:,:) = 0. 
    422       zqsrios (:,:) = 0. 
     419      zalbocsd(:,:) = 0.e0 
     420      zqsro   (:,:) = 0.e0 
     421      zqsrics (:,:) = 0.e0 
     422      zqsrios (:,:) = 0.e0 
    423423 
    424424      DO jt = 1, jpintsr  
    425425#   if defined key_vectopt_loop && ! defined key_autotasking 
    426426         DO ji = 1, jpij   
    427             zalbocsd(ji,1)  = zalbocsd(ji,1) + zdlha(ji,1) * zalbocs(ji,1,jt)   & 
    428                &             / MAX( 2.0 * zlsrise(ji,1) , zeps0 ) 
    429             zqsro   (ji,1)  =   zqsro(ji,1) + zsqsro  (ji,1,jt) 
    430             zqsrics (ji,1)  = zqsrics(ji,1) + zsqsrics(ji,1,jt) 
    431             zqsrios (ji,1)  = zqsrios(ji,1) + zsqsrios(ji,1,jt) 
     427            zalbocsd(ji,1) = zalbocsd(ji,1) + zdlha   (ji,1) * zalbocs(ji,1,jt)   & 
     428               &                                             / MAX( 2.0 * zlsrise(ji,1) , zeps0 ) 
     429            zqsro   (ji,1) = zqsro   (ji,1) + zsqsro  (ji,1,jt) 
     430            zqsrics (ji,1) = zqsrics (ji,1) + zsqsrics(ji,1,jt) 
     431            zqsrios (ji,1) = zqsrios (ji,1) + zsqsrios(ji,1,jt) 
    432432         END DO 
    433433#  else 
    434434         DO jj = 1, jpj 
    435435            DO ji = 1, jpi   
    436                zalbocsd(ji,jj)  = zalbocsd(ji,jj) + zdlha(ji,jj) * zalbocs(ji,jj,jt)   & 
    437                   &             / MAX( 2.0 * zlsrise(ji,jj) , zeps0 ) 
    438                zqsro  (ji,jj)   =   zqsro(ji,jj) + zsqsro  (ji,jj,jt) 
    439                zqsrics(ji,jj)   = zqsrics(ji,jj) + zsqsrics(ji,jj,jt) 
    440                zqsrios(ji,jj)   = zqsrios(ji,jj) + zsqsrios(ji,jj,jt) 
     436               zalbocsd(ji,jj) = zalbocsd(ji,jj) + zdlha(ji,jj) * zalbocs(ji,jj,jt)   & 
     437                  &                                              / MAX( 2.0 * zlsrise(ji,jj) , zeps0 ) 
     438               zqsro  (ji,jj)  = zqsro   (ji,jj) + zsqsro  (ji,jj,jt) 
     439               zqsrics(ji,jj)  = zqsrics (ji,jj) + zsqsrics(ji,jj,jt) 
     440               zqsrios(ji,jj)  = zqsrios (ji,jj) + zsqsrios(ji,jj,jt) 
    441441            END DO 
    442442         END DO 
     
    447447         DO ji = 1, jpi  
    448448 
    449       !-------------------------------------------  
    450       !  Computation of shortwave radiation. 
    451       !------------------------------------------- 
     449            !-------------------------------------------  
     450            !  Computation of shortwave radiation. 
     451            !------------------------------------------- 
    452452 
    453453            ! the solar heat flux absorbed at ocean and snow/ice surfaces 
     
    478478            fr2_i0(ji,jj) = 0.82  * zcatm1(ji,jj) + 0.65 * catm(ji,jj) 
    479479 
    480       !--------------------------------------------------------------------------- 
    481       !   Computation of long-wave radiation  ( Berliand 1952 ; all latitudes ) 
    482       !--------------------------------------------------------------------------- 
     480            !--------------------------------------------------------------------------- 
     481            !   Computation of long-wave radiation  ( Berliand 1952 ; all latitudes ) 
     482            !--------------------------------------------------------------------------- 
    483483 
    484484            ! tempory variables 
     
    633633            !  latent heat flux  
    634634            zqla_ice(ji,jj) = zrhovacshi * ( zqsati        - zqatm(ji,jj) ) 
    635              qla_ice(ji,jj) = zqla_ice(ji,jj) 
     635            qla_ice (ji,jj) = zqla_ice(ji,jj) 
    636636               
    637637            !  Computation of sensitivity of non solar fluxes (dQ/dT) 
     
    750750      !--------------------------  
    751751       
    752       llmask = (hsnif == 0.0) .AND. ( sist >= rt0_ice ) 
     752      llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice ) 
    753753      WHERE ( llmask )   !  ice free of snow and melts 
    754754         zalbfz = albice 
  • trunk/NEMO/OPA_SRC/SBC/flxfwb.F90

    r18 r84  
    130130      IF( lk_mpp )   CALL  mpp_sum( a_rnf    )   ! sum over the global domain 
    131131 
    132       IF( aminus /= 0.0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 
    133       IF( aplus  /= 0.0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  ) 
     132      IF( aminus /= 0.e0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus ) 
     133      IF( aplus  /= 0.e0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  ) 
    134134 
    135135 
  • trunk/NEMO/OPA_SRC/SBC/ocesbc.F90

    r19 r84  
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!    oce_sbc : initialization and namelist read 
     8   !!   oce_sbc     : ??? 
     9   !!   oce_sbc_dmp : ??? 
    910   !!---------------------------------------------------------------------- 
    1011   !! * Modules used 
     
    3435 
    3536   !! * Shared module variables 
    36    REAL(wp), PUBLIC ::   & 
     37   REAL(wp), PUBLIC ::   &  !: 
    3738      aplus, aminus,     &  !: 
    3839      empold = 0.e0         !: current year freshwater budget correction 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
     40   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    4041      qt  ,         &  !: total surface heat flux (w/m2) 
    4142      q   ,         &  !: surface heat flux (w/m2) 
     
    158159 
    159160         ! Re-initialization of fluxes 
    160          sst_io(:,:) = 0.0 
    161          sss_io(:,:) = 0.0 
    162          u_io  (:,:) = 0.0 
    163          v_io  (:,:) = 0.0 
    164          gtaux (:,:) = 0. 
    165          gtauy (:,:) = 0. 
     161         sst_io(:,:) = 0.e0 
     162         sss_io(:,:) = 0.e0 
     163         u_io  (:,:) = 0.e0 
     164         v_io  (:,:) = 0.e0 
     165         gtaux (:,:) = 0.e0 
     166         gtauy (:,:) = 0.e0 
    166167 
    167168      ENDIF 
     
    257258 
    258259         ! Re-initialization of fluxes 
    259          sst_io(:,:) = 0.0 
    260          sss_io(:,:) = 0.0 
    261          u_io  (:,:) = 0.0 
    262          v_io  (:,:) = 0.0 
     260         sst_io(:,:) = 0.e0 
     261         sss_io(:,:) = 0.e0 
     262         u_io  (:,:) = 0.e0 
     263         v_io  (:,:) = 0.e0 
    263264 
    264265      ENDIF 
     
    651652      DO jj = 1, jpj 
    652653         DO ji = 1, jpi 
    653             freezn(ji,jj) = MAX(0., SIGN(1., freeze(ji,jj)-rsmall)) 
     654            freezn(ji,jj) = MAX(0., SIGN(1., freeze(ji,jj)-rsmall) ) 
    654655         END DO 
    655656      END DO 
     
    683684      END DO 
    684685      ! volume flux associated to internal damping to climatology 
    685       dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + rsmall ) 
     686!!ibu dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + rsmall ) 
     687      dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + 1.e-20 ) 
    686688# else 
    687689      dmp(:,:) = 0.e0            ! No internal damping 
     
    698700            zerp = ( 1. - 2.*upsrnfh(ji,jj) ) * zsrp   & 
    699701               & * ( zsss(ji,jj) - s_dta(ji,jj,1) )     & 
    700                & / ( zsss(ji,jj) + rsmall        ) 
     702               & / ( zsss(ji,jj) + 1.e-20        ) 
     703!ib            & / ( zsss(ji,jj) + rsmall        ) 
    701704             
    702705            zerp = MIN( zerp, zplus  ) 
     
    719722      IF( lk_mpp )   CALL mpp_sum( aplus  )   ! sums over the global domain 
    720723      IF( lk_mpp )   CALL mpp_sum( aminus ) 
    721       IF( l_ctl .AND. lwp ) WRITE(numout,*) ' oce_sbc_dmp : a+ = ', aplus, ' a- = ', aminus 
     724      IF(l_ctl)  WRITE(numout,*) ' oce_sbc_dmp : a+ = ', aplus, ' a- = ', aminus 
    722725 
    723726      zadefi = MIN( aplus, aminus ) 
    724       IF( zadefi == 0.0 ) THEN  
     727      IF( zadefi == 0.e0 ) THEN  
    725728         erp(:,:) = 0.e0 
    726729      ELSE 
     
    732735      erp(:,:) = ( 1. - zfreeze(:,:) ) * zsrp    &   ! surface restoring term 
    733736         &     * ( zsss(:,:) - s_dta(:,:,1) )     & 
    734          &     / ( zsss(:,:) + rsmall      ) 
     737         &     / ( zsss(:,:) + 1.e-20      ) 
     738!ib      &     / ( zsss(:,:) + rsmall      ) 
    735739#endif 
    736740 
Note: See TracChangeset for help on using the changeset viewer.