Changeset 4738 for LMDZ6


Ignore:
Timestamp:
Oct 24, 2023, 12:58:23 PM (14 months ago)
Author:
oboucher
Message:

cleaning up this routine

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/add_phys_tend_mod.F90

    r4523 r4738  
    7171        zzdt(i, k) = hthturb_gcssold(k)*dtime_frcg
    7272        zzdq(i, k) = hqturb_gcssold(k)*dtime_frcg
    73       END DO
    74     END DO
     73      ENDDO
     74    ENDDO
    7575    PRINT *, ' add_pbl_tend, dtime_frcg ', dtime_frcg
    7676    PRINT *, ' add_pbl_tend, zzdt ', zzdt
    … …  
    7979  ELSE
    8080    CALL add_phys_tend(zdu, zdv, zdt, zdq, zdql, zdqi, zdqbs, paprs, text,abortphy,flag_inhib_tend, itap, 0)
    81   END IF
    82 
     81  ENDIF
    8382
    8483  RETURN
    … …  
    110109  &           , d_h_qw_col, d_h_ql_col, d_h_qs_col, d_h_qbs_col, d_h_col
    111110IMPLICIT none
    112   include "YOMCST.h"
    113   include "clesphys.h"
     111INCLUDE "YOMCST.h"
     112INCLUDE "clesphys.h"
    114113
    115114! Arguments :
    … …  
    148147LOGICAL done(klon)
    149148
    150 integer debug_level
    151 logical, save :: first=.true.
     149INTEGER debug_level
     150LOGICAL, SAVE :: first=.true.
    152151!$OMP THREADPRIVATE(first)
    153152!
    … …  
    179178REAL zh_qw_col(klon,2), zh_ql_col(klon,2), zh_qs_col(klon,2), zh_qbs_col(klon,2)
    180179REAL zh_col(klon,2)
    181 
    182180REAL zcpvap, zcwat, zcice
    183181
    … …  
    185183! Initialisations
    186184
    187      IF (prt_level >= 5) then
    188         write (*,*) "In add_phys_tend, after ",text
    189         call flush
    190      end if
    191 
    192      ! if flag_inhib_tend != 0, tendencies are not added
    193      IF (flag_inhib_tend /= 0) then
    194         ! If requiered, diagnostics are shown
    195         IF (flag_inhib_tend > 0) then
    196            ! print some diagnostics if xxx_seri have changed
    197            call cmp_seri(flag_inhib_tend,text)
    198         END IF
    199         RETURN ! on n ajoute pas les tendance
    200      END IF
    201 
    202      IF (abortphy==1) RETURN ! on n ajoute pas les tendance si le modele
    203                               ! a deja plante.
    204 
    205      debug_level=10
    206      if (first) then
    207         print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
    208         first=.false.
    209      endif
     185  IF (prt_level >= 5) THEN
     186     write (*,*) "In add_phys_tend, after ",text
     187     CALL flush
     188  ENDIf
     189
     190  ! if flag_inhib_tend != 0, tendencies are not added
     191  IF (flag_inhib_tend /= 0) THEN
     192     ! If requiered, diagnostics are shown
     193     IF (flag_inhib_tend > 0) THEN
     194        ! print some diagnostics if xxx_seri have changed
     195        call cmp_seri(flag_inhib_tend,text)
     196     ENDIF
     197     RETURN ! on n ajoute pas les tendance
     198  ENDIF
     199
     200  IF (abortphy==1) RETURN ! on n ajoute pas les tendance si le modele a deja plante.
     201
     202  debug_level=10
     203  IF (first) THEN
     204     print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
     205     first=.false.
     206  ENDIF
    210207!
    211208!  print *,'add_phys_tend: paprs ',paprs
    … …  
    227224    ! layer air mass
    228225    zairm(:, k) = (paprs(:,k)-paprs(:,k+1))/rg
    229   END DO
    230 
    231   if (fl_ebil .GT. 0) then
     226  ENDDO
     227
     228  IF (fl_ebil .GT. 0) THEN
    232229    ! ------------------------------------------------
    233230    ! Compute vertical sum for each atmospheric column
    … …  
    244241                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
    245242
    246   end if ! end if (fl_ebil .GT. 0)
     243  ENDIF ! endif (fl_ebil .GT. 0)
    247244
    248245!======================================================================
    … …  
    250247!======================================================================
    251248
    252      u_seri(:,:)=u_seri(:,:)+zdu(:,:)
    253      v_seri(:,:)=v_seri(:,:)+zdv(:,:)
    254      ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
    255      qs_seri(:,:)=qs_seri(:,:)+zdqi(:,:)
    256      qbs_seri(:,:)=qbs_seri(:,:)+zdqbs(:,:)
     249  u_seri(:,:)=u_seri(:,:)+zdu(:,:)
     250  v_seri(:,:)=v_seri(:,:)+zdv(:,:)
     251  ql_seri(:,:)=ql_seri(:,:)+zdql(:,:)
     252  qs_seri(:,:)=qs_seri(:,:)+zdqi(:,:)
     253  qbs_seri(:,:)=qbs_seri(:,:)+zdqbs(:,:)
    257254
    258255!======================================================================
    … …  
    261258!======================================================================
    262259
    263       jbad=0
    264       jqbad=0
    265       DO k = 1, klev
    266          DO i = 1, klon
    267             zt=t_seri(i,k)+zdt(i,k)
    268             zq=q_seri(i,k)+zdq(i,k)
    269             IF ( zt>370. .or. zt<130. .or. abs(zdt(i,k))>50. ) then
    270             jbad = jbad + 1
    271             jadrs(jbad) = i
    272             kadrs(jbad) = k
    273             ENDIF
    274             IF ( zq<0. .or. zq>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
    275             jqbad = jqbad + 1
    276             jqadrs(jqbad) = i
    277             kqadrs(jqbad) = k
    278             ENDIF
    279             t_seri(i,k)=zt
    280             q_seri(i,k)=zq
    281          ENDDO
    282       ENDDO
     260  jbad=0
     261  jqbad=0
     262  DO k = 1, klev
     263     DO i = 1, klon
     264        zt=t_seri(i,k)+zdt(i,k)
     265        zq=q_seri(i,k)+zdq(i,k)
     266        IF ( zt>370. .or. zt<130. .or. abs(zdt(i,k))>50. ) THEN
     267           jbad = jbad + 1
     268           jadrs(jbad) = i
     269           kadrs(jbad) = k
     270        ENDIF
     271        IF ( zq<0. .or. zq>0.1 .or. abs(zdq(i,k))>1.e-2 ) THEN
     272           jqbad = jqbad + 1
     273           jqadrs(jqbad) = i
     274           kqadrs(jqbad) = k
     275        ENDIF
     276        t_seri(i,k)=zt
     277        q_seri(i,k)=zq
     278     ENDDO
     279  ENDDO
    283280
    284281!=====================================================================================
    … …  
    286283!=====================================================================================
    287284
    288 IF (jbad .GT. 0) THEN
    289       DO j = 1, jbad
    290          i=jadrs(j)
    291          if(prt_level.ge.debug_level) THEN
     285  IF (jbad .GT. 0) THEN
     286     DO j = 1, jbad
     287        i=jadrs(j)
     288        IF (prt_level.ge.debug_level) THEN
    292289          print*,'PLANTAGE POUR LE POINT i lon lat =',&
    293290                 i,longitude_deg(i),latitude_deg(i),text
    … …  
    297294          ENDDO
    298295          call print_debug_phys(i,debug_level,text)
    299          endif
    300       ENDDO
    301 ENDIF
     296        ENDIF
     297     ENDDO
     298  ENDIF
    302299!
    303300!=====================================================================================
    304301! Impression, warning et correction en cas de probleme moins important
    305302!=====================================================================================
    306 IF (jqbad .GT. 0) THEN
     303  IF (jqbad .GT. 0) THEN
    307304      done(:) = .false.                         !jyg
    308305      DO j = 1, jqbad
    … …  
    315312              write(*,'(i3,2f14.4,2e14.2)') k,t_seri(i,k),zdt(i,k),q_seri(i,k),zdq(i,k)
    316313           ENDDO
    317           endif
     314          ENDIF
    318315          IF (ok_conserv_q) THEN
    319316!jyg<20140228 Corrections pour conservation de l'eau
    … …  
    328325                zqp_int = zqp_int + zqp(k)     *(paprs(i,k)-paprs(i,k+1))/Rg
    329326              ENDDO
    330               if(prt_level.ge.debug_level) THEN
     327              IF (prt_level.ge.debug_level) THEN
    331328               print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
    332329                                    i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
    333               endif
     330              ENDIF
    334331              DO k = 1, klev
    335332                zq_new = zqp(k)*zq_int/zqp_int
    … …  
    343340            DO k = 1, klev
    344341              zq=q_seri(i,k)+zdq(i,k)
    345               if (zq.lt.1.e-15) then
    346                  if (q_seri(i,k).lt.1.e-15) then
    347                   if(prt_level.ge.debug_level) THEN
    348                    print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
    349                   endif
    350                   q_seri(i,k)=1.e-15
    351                   zdq(i,k)=(1.e-15-q_seri(i,k))
    352                  endif
    353               endif
     342              IF (zq.lt.1.e-15) THEN
     343                 IF (q_seri(i,k).lt.1.e-15) THEN
     344                   IF (prt_level.ge.debug_level) THEN
     345                    print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
     346                   ENDIF
     347                   q_seri(i,k)=1.e-15
     348                   zdq(i,k)=(1.e-15-q_seri(i,k))
     349                 ENDIF
     350              ENDIF
    354351!              zq=q_seri(i,k)+zdq(i,k)
    355 !              if (zq.lt.1.e-15) then
     352!              if (zq.lt.1.e-15) THEN
    356353!                 zdq(i,k)=(1.e-15-q_seri(i,k))
    357354!              endif
    … …  
    361358!jyg>
    362359      ENDDO ! j = 1, jqbad
    363 ENDIF
     360  ENDIF
    364361!
    365362
    366363!IM ajout memes tests pour reverifier les jbad, jqbad beg
    367       jbad=0
    368       jqbad=0
    369       DO k = 1, klev
    370          DO i = 1, klon
    371             IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) then
    372             jbad = jbad + 1
    373             jadrs(jbad) = i
    374 !            if(prt_level.ge.debug_level) THEN
    375 !             print*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
    376 !            endif
    377             ENDIF
    378             IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) then
    379             jqbad = jqbad + 1
    380             jqadrs(jqbad) = i
    381             kqadrs(jqbad) = k
    382 !            if(prt_level.ge.debug_level) THEN
    383 !             print*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
    384 !            endif
    385             ENDIF
    386          ENDDO
    387       ENDDO
    388 IF (jbad .GT. 0) THEN
     364  jbad=0
     365  jqbad=0
     366  DO k = 1, klev
     367     DO i = 1, klon
     368        IF ( t_seri(i,k)>370. .or. t_seri(i,k)<130. .or. abs(zdt(i,k))>50. ) THEN
     369        jbad = jbad + 1
     370        jadrs(jbad) = i
     371!         if(prt_level.ge.debug_level) THEN
     372!         print*,'cas2 i k t_seri zdt',i,k,t_seri(i,k),zdt(i,k)
     373!        endif
     374        ENDIF
     375        IF ( q_seri(i,k)<0. .or. q_seri(i,k)>0.1 .or. abs(zdq(i,k))>1.e-2 ) THEN
     376        jqbad = jqbad + 1
     377        jqadrs(jqbad) = i
     378        kqadrs(jqbad) = k
     379!        if(prt_level.ge.debug_level) THEN
     380!         print*,'cas2 i k q_seri zdq',i,k,q_seri(i,k),zdq(i,k)
     381!        endif
     382        ENDIF
     383     ENDDO
     384  ENDDO
     385  IF (jbad .GT. 0) THEN
    389386      DO j = 1, jbad
    390387         i=jadrs(j)
    … …  
    400397          ENDDO
    401398          call print_debug_phys(i,debug_level,text)
    402          endif
     399         ENDIF
    403400      ENDDO
    404 ENDIF
    405 !
    406 IF (jqbad .GT. 0) THEN
     401  ENDIF
     402!
     403  IF (jqbad .GT. 0) THEN
    407404      DO j = 1, jqbad
    408405         i=jqadrs(j)
    409406         k=kqadrs(j)
    410          if(prt_level.ge.debug_level) THEN
     407         IF (prt_level.ge.debug_level) THEN
    411408          print*,'WARNING  : EAU2 POUR LE POINT i itap lon lat txt jqbad zdq q zdql ql',&
    412409                 i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,&
    … …  
    418415          ENDDO
    419416          call print_debug_phys(i,debug_level,text)
    420          endif
     417         ENDIF
    421418      ENDDO
    422 ENDIF
     419  ENDIF
    423420
    424421!======================================================================
    … …  
    429426!======================================================================
    430427
    431       CALL hgardfou(t_seri,ftsol,text,abortphy)
    432       IF (abortphy==1) THEN
    433         Print*,'ERROR ABORT hgardfou dans ',text
     428  CALL hgardfou(t_seri,ftsol,text,abortphy)
     429  IF (abortphy==1) THEN
     430    print*,'ERROR ABORT hgardfou dans ',text
    434431! JLD pourquoi on ne modifie pas de meme t_seri et q_seri ?
    435         u_seri(:,:)=u_seri(:,:)-zdu(:,:)
    436         v_seri(:,:)=v_seri(:,:)-zdv(:,:)
    437         ql_seri(:,:)=ql_seri(:,:)-zdql(:,:)
    438         qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:)
    439         qbs_seri(:,:)=qbs_seri(:,:)-zdqbs(:,:)
    440       ENDIF
     432    u_seri(:,:)=u_seri(:,:)-zdu(:,:)
     433    v_seri(:,:)=v_seri(:,:)-zdv(:,:)
     434    ql_seri(:,:)=ql_seri(:,:)-zdql(:,:)
     435    qs_seri(:,:)=qs_seri(:,:)-zdqi(:,:)
     436    qbs_seri(:,:)=qbs_seri(:,:)-zdqbs(:,:)
     437  ENDIF
    441438
    442439!======================================================================
    … …  
    444441!======================================================================
    445442
    446   if (fl_ebil .GT. 0) then
     443  IF (fl_ebil .GT. 0) THEn
    447444 
    448445    ! ------------------------------------------------
    … …  
    476473    d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep
    477474
    478   end if ! end if (fl_ebil .GT. 0)
     475  ENDIF ! endif (fl_ebil .GT. 0)
    479476!
    480477! When in diagnostic mode, restore "out" variables to initial values.
    … …  
    530527REAL, DIMENSION(nlon,nlev)      :: uu_n, vv_n
    531528REAL, DIMENSION(nlon,nlev)      :: temp_n, qv_n, ql_n, qs_n, qbs_n
    532 
    533 
    534529!
    535530INTEGER k, n
    536531
    537 integer debug_level
    538 logical, save :: first=.true.
     532INTEGER debug_level
     533LOGICAL, SAVE :: first=.true.
    539534!$OMP THREADPRIVATE(first)
    540535!
    … …  
    569564! Initialisations
    570565
    571      IF (prt_level >= 5) then
    572         write (*,*) "In diag_phys_tend, after ",text
    573         call flush
    574      end if
    575 
    576      debug_level=10
    577      if (first) then
    578         print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
    579         first=.false.
    580      endif
     566  IF (prt_level >= 5) THEN
     567     write (*,*) "In diag_phys_tend, after ",text
     568     CALL flush
     569  ENDIF
     570
     571  debug_level=10
     572  IF (first) THEN
     573     print *,"TestJLD rcpv, rcw, rcs",rcpv, rcw, rcs
     574     first=.false.
     575  ENDIF
    581576!
    582577!  print *,'add_phys_tend: paprs ',paprs
    … …  
    587582    ! layer air mass
    588583    zairm(:, k) = (paprs(:,k)-paprs(:,k+1))/rg
    589   END DO
    590 
    591   if (fl_ebil .GT. 0) then
     584  ENDDO
     585
     586  IF (fl_ebil .GT. 0) THEN
    592587    ! ------------------------------------------------
    593588    ! Compute vertical sum for each atmospheric column
    … …  
    600595                    zh_qw_col(:,n), zh_ql_col(:,n), zh_qs_col(:,n), zh_qbs_col(:,n), zh_col(:,n))
    601596
    602   end if ! end if (fl_ebil .GT. 0)
     597  ENDIF ! endif (fl_ebil .GT. 0)
    603598
    604599!======================================================================
    … …  
    606601!======================================================================
    607602
    608      uu_n(:,:)=uu(:,:)+zdu(:,:)
    609      vv_n(:,:)=vv(:,:)+zdv(:,:)
    610      qv_n(:,:)=qv(:,:)+zdq(:,:)
    611      ql_n(:,:)=ql(:,:)+zdql(:,:)
    612      qs_n(:,:)=qs(:,:)+zdqs(:,:)
    613      qbs_n(:,:)=qbs(:,:)+zdqbs(:,:)
    614      temp_n(:,:)=temp(:,:)+zdt(:,:)
    615 
    616 
     603  uu_n(:,:)=uu(:,:)+zdu(:,:)
     604  vv_n(:,:)=vv(:,:)+zdv(:,:)
     605  qv_n(:,:)=qv(:,:)+zdq(:,:)
     606  ql_n(:,:)=ql(:,:)+zdql(:,:)
     607  qs_n(:,:)=qs(:,:)+zdqs(:,:)
     608  qbs_n(:,:)=qbs(:,:)+zdqbs(:,:)
     609  temp_n(:,:)=temp(:,:)+zdt(:,:)
    617610
    618611!======================================================================
    … …  
    620613!======================================================================
    621614
    622   if (fl_ebil .GT. 0) then
     615  IF (fl_ebil .GT. 0) THEN
    623616 
    624617    ! ------------------------------------------------
    … …  
    644637    d_ek_col(:) = (zek_col(:,2)-zek_col(:,1))/phys_tstep
    645638
    646    print *,'zdu ', zdu
    647    print *,'zdv ', zdv
    648    print *,'d_ek_col, zek_col(2), zek_col(1) ',d_ek_col(1), zek_col(1,2), zek_col(1,1)
     639    print *,'zdu ', zdu
     640    print *,'zdv ', zdv
     641    print *,'d_ek_col, zek_col(2), zek_col(1) ',d_ek_col(1), zek_col(1,2), zek_col(1,1)
    649642
    650643    d_h_dair_col(:) = (zh_dair_col(:,2)-zh_dair_col(:,1))/phys_tstep
    … …  
    656649    d_h_col = (zh_col(:,2)-zh_col(:,1))/phys_tstep
    657650
    658   end if ! end if (fl_ebil .GT. 0)
     651  ENDIF ! endif (fl_ebil .GT. 0)
    659652!
    660653
    … …  
    668661
    669662IMPLICIT none
    670   include "YOMCST.h"
     663INCLUDE "YOMCST.h"
    671664
    672665INTEGER,                    INTENT(IN)    :: nlon,nlev
    … …  
    685678
    686679INTEGER          :: i, k
    687 
    688680
    689681  ! Reset variables
    … …  
    720712        zh_qs_col(i) = zh_qs_col(i) + (zcpvap*temp(i, k) - rlstt)*qs(i, k)*zairm(i, k)   !jyg
    721713        zh_qbs_col(i) = zh_qbs_col(i) + (zcpvap*temp(i, k) - rlstt)*qbs(i, k)*zairm(i, k)   !jyg
    722       END DO
    723     END DO
     714      ENDDO
     715    ENDDO
    724716    ! compute total air enthalpy
    725717    zh_col(:) = zh_dair_col(:) + zh_qw_col(:) + zh_ql_col(:) + zh_qs_col(:) + zh_qbs_col(:)
    … …  
    749741USE climb_hq_mod, ONLY : d_h_col_vdf, f_h_bnd
    750742IMPLICIT none
    751 include "YOMCST.h"
     743INCLUDE "YOMCST.h"
    752744
    753745! Arguments :
    754746!------------
    755747CHARACTER*(*) text ! text specifing the involved parametrization
    756 integer itap        ! time step number
     748INTEGER itap        ! time step number
    757749! local variables
    758750! ---------------
    759 real bilq_seuil,  bilh_seuil ! thresold on error in Q and H budget
    760 real bilq_error,  bilh_error ! erros in Q and H budget
    761 real bilq_bnd,  bilh_bnd     ! Q and H budget due to exchange with boundaries
    762 integer bilq_ok,  bilh_ok
     751REAL bilq_seuil,  bilh_seuil ! thresold on error in Q and H budget
     752REAL bilq_error,  bilh_error ! erros in Q and H budget
     753REAL bilq_bnd,  bilh_bnd     ! Q and H budget due to exchange with boundaries
     754INTEGER bilq_ok,  bilh_ok
    763755CHARACTER*(12) status
    764756
    … …  
    769761
    770762!!print *,'prt_level:',prt_level,' fl_ebil:',fl_ebil,' fl_cor_ebil:',fl_cor_ebil
    771 if ( (fl_ebil .GT. 0) .and. (klon .EQ. 1)) then
     763IF ((fl_ebil .GT. 0) .AND. (klon .EQ. 1)) THEN
    772764
    773765  bilq_bnd = 0.
    … …  
    801793  bilh_error = d_h_col(1) - bilh_bnd
    802794! are the errors too large?
    803   if ( abs(bilq_error) .gt. bilq_seuil) bilq_ok=1
    804   if ( abs(bilh_error) .gt. bilh_seuil) bilh_ok=1
     795  IF (abs(bilq_error) .GT. bilq_seuil) bilq_ok=1
     796  IF (abs(bilh_error) .GT. bilh_seuil) bilh_ok=1
    805797!
    806798! Print diagnostics
    807799! =================
    808   if ( (bilq_ok .eq. 0).and.(bilh_ok .eq. 0) ) then
     800  IF ( (bilq_ok .eq. 0).AND.(bilh_ok .eq. 0) ) THEN
    809801    status="enerbil-OK"
    810   else
     802  ELSE
    811803    status="enerbil-PB"
    812   end if
    813 
    814   if ( prt_level .GE. 3) then
     804  ENDIF
     805
     806  IF (prt_level .GE. 3) THEN
    815807    write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error,"  H", bilh_error
    8168089010  format (1x,A8,2x,A12,A6,I4,A18,E15.6,A5,E15.6)
    817   end if
    818   if ( prt_level .GE. 3) then
     809  ENDIF
     810  IF (prt_level .GE. 3) THEN
    819811    write(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1)
    820   end if
    821   if ( prt_level .GE. 5) then
     812  ENDIF
     813  IF (prt_level .GE. 5) THEN
    822814    write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd
    823815    write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1), d_qbs_col(1)
    824816    write(*,9000) text,"enerbil: enthalpy budget",d_h_col(1),d_h_dair_col(1),d_h_qw_col(1),d_h_ql_col(1),d_h_qs_col(1),d_h_qbs_col(1)
    825   end if
     817  ENDIF
    826818
    827819  specific_diag: SELECT CASE (text)
    828820  CASE("vdf") specific_diag
    829     if ( prt_level .GE. 5) then
     821    IF (prt_level .GE. 5) THEN
    830822      write(*,9000) text,"enerbil: d_h, bilh, sens,t_seri", d_h_col(1), bilh_bnd, sens(1), t_seri(1,1)
    831823      write(*,9000) text,"enerbil: d_h_col_vdf, f_h, diff",d_h_col_vdf, f_h_bnd, bilh_bnd-sens(1)
    832     end if
     824    ENDIF
    833825  CASE("lsc") specific_diag
    834     if ( prt_level .GE. 5) then
     826    IF (prt_level .GE. 5) THEN
    835827      write(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_lsc(1), rlvtt * rain_lsc(1), -(rcw-rcpd)*t_seri(1,1) * rain_lsc(1)
    836828      write(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_lsc(1), rlstt * snow_lsc(1), -(rcs-rcpd)*t_seri(1,1) * snow_lsc(1)
    837     end if
     829    ENDIF
    838830  CASE("convection") specific_diag
    839     if ( prt_level .GE. 5) then
     831    IF (prt_level .GE. 5) THEN
    840832      write(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_con(1), rlvtt * rain_con(1), -(rcw-rcpd)*t_seri(1,1) * rain_con(1)
    841833      write(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_con(1), rlstt * snow_con(1), -(rcs-rcpd)*t_seri(1,1) * snow_con(1)
    842     end if
     834    ENDIF
    843835  END SELECT specific_diag
    844836
    845 9000 format (1x,A8,2x,A35,10E15.6)
    846 
    847 end if ! end if (fl_ebil .GT. 0)
     8379000 FORMAT(1x,A8,2x,A35,10E15.6)
     838
     839ENDIF ! endif (fl_ebil .GT. 0)
    848840
    849841END SUBROUTINE prt_enerbil
Note: See TracChangeset for help on using the changeset viewer.