Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (3 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1Dconv.h

    r4593 r5099  
    1 !
     1
    22! $Id$
    3 !
     3
    44        subroutine get_uvd(itap,dtime,file_forctl,file_fordat,                  &
    55     &       ht,hq,hw,hu,hv,hthturb,hqturb,                                     &
    66     &       Ts,imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)                                 
    7 !
     7
    88        implicit none
    99 
    … …  
    109109        real Tsbef
    110110        save htbef,hqbef,hwbef,hubef,hvbef,hthturbbef,hqturbbef
    111 !
     111
    112112        real timeaft,timebef
    113113        save timeaft,timebef
    … …  
    131131        real hqturb_mes(100) !tendance horizontale d humidite, due aux
    132132                              !flux turbulents
    133 !
     133
    134134!---------------------------------------------------------------------
    135135! variable argument de la subroutine copie
    … …  
    149149!*** on determine le pas du meso_NH correspondant au nouvel itap ***
    150150!*** pour aller chercher les champs dans rdgrads                 ***
    151 !
     151
    152152        time=time0+itap*dtime
    153153!c        temps=int(time/dt+1)
    … …  
    156156        pas=min(temps,pasmax-1)
    157157             print*,'le pas Meso est:',pas
    158 !
    159 !
     158
     159
    160160!===================================================================
    161 !
     161
    162162!*** on remplit les champs before avec les champs after du pas   ***
    163163!*** precedent en format gcm                                     ***
    … …  
    190190     &                  ,hu_mes,hv_mes,hthturb_mes,hqturb_mes                 &
    191191     &                  ,ts_fcg,ts_subr,imp_fcg,Turb_fcg)
    192 !
    193192
    194193               if(Tp_fcg) then
    … …  
    203202         enddo
    204203        endif  ! Turb_fcg
    205 !
     204
    206205               print*,'ht_mes ',(ht_mes(i),i=1,nblvlm)
    207206               print*,'hq_mes ',(hq_mes(i),i=1,nblvlm)
    … …  
    286285         ts_subr = ((timeaft-time)*tsbef + (time-timebef)*tsaft)/dt
    287286       endif ! temps.ge.pasmax
    288 !
     287
    289288        print *,' time,timebef,timeaft',time,timebef,timeaft
    290289        print *,' ht,htbef,htaft,hthturb,hthturbbef,hthturbaft'
    … …  
    298297     &             hqturb(j),hqturbbef(j),hqturbaft(j)
    299298        enddo
    300 !
     299
    301300!-------------------------------------------------------------------
    302 !
     301
    303302         IF (Ts_fcg) Ts = Ts_subr
    304303         return
    305 !
     304
    306305!-----------------------------------------------------------------------
    307306! on sort les champs de "convergence" pour l instant initial 'in'
    … …  
    312311     &           imp_fcg,ts_fcg,Tp_fcg,Turb_fcg)
    313312             print*,'le pas itap est:',itap
    314 !
     313
    315314!===================================================================
    316 !
     315
    317316       write(*,'(a)') 'OPEN '//file_forctl
    318317       open(97,FILE=file_forctl,FORM='FORMATTED')
    319 !
     318
    320319!------------------
    321320      do i=1,1000
    … …  
    355354                  pasprev=in-1
    356355                  time0=dt*pasprev
    357 !
     356
    358357          close(98)
    359 !
     358
    360359      write(*,'(a)') 'OPEN '//file_fordat
    361360      open(99,FILE=file_fordat,FORM='UNFORMATTED',                          &
    … …  
    371370          print *, 'get_uvd : rdgrads ->'
    372371          print *, tp_fcg
    373 !
     372
    374373! following commented out because we have temperature already in ARM case
    375374!   (otherwise this is the potential temperature )
    … …  
    445444          close(99)
    446445          close(98)
    447 !
     446
    448447!-------------------------------------------------------------------
    449 !
    450 !
     448
     449
    451450 100      IF (Ts_fcg) Ts = Ts_subr
    452451        return
    453 !
     452
    454453999     continue
    455454        stop 'erreur lecture, file forcing.ctl'
    … …  
    565564      SUBROUTINE mesolupbis(file_forctl)
    566565      implicit none
    567 !
     566
    568567!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    569 !
     568
    570569! Lecture descripteur des donnees MESO-NH (forcing.ctl):
    571570! -------------------------------------------------------
    572 !
     571
    573572!     Cette subroutine lit dans le fichier de controle "essai.ctl"
    574573!     et affiche le nombre de niveaux du Meso-NH ainsi que les valeurs
    575574!     des pressions en milieu de couche du Meso-NH (en Pa puis en hPa).
    576575!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    577 !
     576
    578577      INTEGER nblvlm !nombre de niveau de pression du mesoNH
    579578      REAL playm(100)  !pression en Pa milieu de chaque couche Meso-NH
    … …  
    591590      lu=9
    592591      open(lu,file=file_forctl,form='formatted')
    593 !
     592
    594593      do i=1,1000
    595594      read(lu,1000,end=999) a
    596595      if (a .eq. 'ZDEF') go to 100
    597596      enddo
    598 !
     597
    599598 100  backspace(lu)
    600599      print*,'  DESCRIPTION DES 2 MODELES : '
    601600      print*,' '
    602 !
     601
    603602      read(lu,2000) aaa
    604603 2000  format (a80)
    … …  
    607606         read(anblvl,*) nblvlm
    608607
    609 !
    610608      print*,'nbre de niveaux de pression Meso-NH :',nblvlm
    611609      print*,' '
    612610      print*,'pression en Pa de chaque couche du meso-NH :'
    613 !
     611
    614612      read(lu,*) (playm(mlz),mlz=1,nblvlm)
    615613!      Si la pression est en HPa, la multiplier par 100
    … …  
    620618      endif
    621619      print*,(playm(mlz),mlz=1,nblvlm)
    622 !
     620
    623621 1000 format (a4)
    624622 1001 format(5x,i2)
    625 !
     623
    626624      print*,' '
    627625      do mlzh=1,nblvlm
    628626      hplaym(mlzh)=playm(mlzh)/100.
    629627      enddo
    630 !
     628
    631629      print*,'pression en hPa de chaque couche du meso-NH: '
    632630      print*,(hplaym(mlzh),mlzh=1,nblvlm)
    633 !
     631
    634632      close (lu)
    635633      return
    636 !
     634
    637635 999  stop 'erreur lecture des niveaux pression des donnees'
    638636      end
    … …  
    645643      real hthtur(nl),hqtur(nl)
    646644      real ts
    647 !
     645
    648646      INTEGER k
    649 !
     647
    650648      LOGICAL imp_fcg,ts_fcg,Turb_fcg
    651 !
     649
    652650      icomp = icount
    653 !
    654 !
     651
     652
    655653         do k=1,nl
    656654            icomp=icomp+1
    … …  
    667665            read(itape,rec=icomp)hQ(k)
    668666         enddo
    669 !
     667
    670668             if(turb_fcg) then
    671669         do k=1,nl
    … …  
    679677             endif
    680678         print *,' apres lecture hthtur, hqtur'
    681 !
     679
    682680          if(imp_fcg) then
    683681
    … …  
    692690
    693691          endif
    694 !
     692
    695693         do k=1,nl
    696694            icomp=icomp+1
    697695            read(itape,rec=icomp)hw(k)
    698696         enddo
    699 !
     697
    700698              if(ts_fcg) then
    701699         icomp=icomp+1
    702700         read(itape,rec=icomp)ts
    703701              endif
    704 !
     702
    705703      print *,' rdgrads ->'
    706704
    … …  
    756754       endif
    757755      enddo
    758 !
     756
    759757!c      if (play(klev) .le. playm(nblvlm)) then
    760758!c         mlz=nblvlm-1
    … …  
    765763!c     *            /(playm(mlz+1)-playm(mlz))
    766764!c      endif
    767 !
     765
    768766      print*,' '
    769767      print*,'         INTERPOLATION  : '
    … …  
    779777      print*,'valeurs du deuxieme coef d"interpolation pour les 9 niveaux:'
    780778      print*,(coef2(k),k=1,klev)
    781 !
     779
    782780      return
    783781      end
    … …  
    821819      END
    822820      CHARACTER*(*) FUNCTION SPACES(STR,NSPACE)
    823 !
     821
    824822! CERN PROGLIB# M433    SPACES          .VERSION KERNFOR  4.14  860211
    825823! ORIG.  6/05/86 M.GOOSSENS/DD
    826 !
     824
    827825!-    The function value SPACES returns the character string STR with
    828826!-    leading blanks removed and each occurence of one or more blanks
    829827!-    replaced by NSPACE blanks inside the string STR
    830 !
     828
    831829      CHARACTER*(*) STR
    832 !
     830
    833831      LENSPA = LEN(SPACES)
    834832      SPACES = ' '
    … …  
    853851  999 END
    854852      FUNCTION INDEXC(STR,SSTR)
    855 !
     853
    856854! CERN PROGLIB# M433    INDEXC          .VERSION KERNFOR  4.14  860211
    857855! ORIG. 26/03/86 M.GOOSSENS/DD
    858 !
     856
    859857!-    Find the leftmost position where substring SSTR does not match
    860858!-    string STR scanning forward
    861 !
     859
    862860      CHARACTER*(*) STR,SSTR
    863 !
     861
    864862      LENS   = LEN(STR)
    865863      LENSS  = LEN(SSTR)
    866 !
     864
    867865      DO 10 I=1,LENS-LENSS+1
    868866          IF (STR(I:I+LENSS-1).NE.SSTR) THEN
    … …  
    872870   10 CONTINUE
    873871      INDEXC = 0
    874 !
     872
    875873  999 END
Note: See TracChangeset for help on using the changeset viewer.