Changeset 1858


Ignore:
Timestamp:
Dec 15, 2017, 12:55:40 PM (7 years ago)
Author:
aslmd
Message:

added gfortran support for old GCM. commented part of ch.f which pose problems (not used anyway in low-atmosphere GCM for mesoscale applications. added an adapted makegcm_gnu. corrected a problem of condition in newstart picked by picky gfortran.

Location:
trunk/MESOSCALE/LMDZ.MARS
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/MESOSCALE/LMDZ.MARS/in_lmdz_mars/compile

    r69 r1858  
    3737echo compile newstart
    3838echo check in $PWD/libo/log_compile_newstart
    39 makegcm -t ${tracers} -p mars -d ${nx}x${ny}x${nz} newstart | tee libo/log_compile_newstart | grep 'warnings' >> libo/log_compile_newstart
     39makegcm -t ${tracers} -p mars -d ${nx}x${ny}x${nz} newstart > libo/log_compile_newstart 2>&1 #| tee libo/log_compile_newstart | grep 'warnings' >> libo/log_compile_newstart
    4040
    4141echo compile gcm
    4242echo check in $PWD/libo/log_compile_gcm
    43 makegcm -t ${tracers} -p mars -d ${nx}x${ny}x${nz} gcm | tee libo/log_compile_gcm | grep 'warnings' >> libo/log_compile_gcm
     43makegcm -t ${tracers} -p mars -d ${nx}x${ny}x${nz} gcm > libo/log_compile_gcm 2>&1 #| tee libo/log_compile_gcm | grep 'warnings' >> libo/log_compile_gcm
    4444
    4545echo well, OK.
  • trunk/MESOSCALE/LMDZ.MARS/libf_gcm/aeronomars/ch.F

    r57 r1858  
    416416  220 dcadre = cadre                                                           
    417417 9000 continue                                                                 
    418       if (ier .ne. 0) call uertst (ier,6hdcadre)                               
     418      !if (ier .ne. 0) call uertst (ier,6hdcadre)                               
    419419 9005 return                                                                   
    420420      end     
    421421
    422422
    423 ******************************************************************************
    424 
    425         subroutine uertst (ier,name)                                             
    426 c                                  specifications for arguments                 
    427       integer            ier                                                   
    428       integer            name(2)                                               
    429 c                                  specifications for local variables           
    430       integer            i,ieq,ieqdf,iounit,level,levold,nameq(6),             
    431      *                   namset(6),namupk(6),nin,nmtb                           
    432       data               namset/1hu,1he,1hr,1hs,1he,1ht/                       
    433       data               nameq/6*1h /                                           
    434       data               level/4/,ieqdf/0/,ieq/1h=/                             
    435 c                                  unpack name into namupk                     
    436 c                                  first executable statement                   
    437       call uspkd (name,6,namupk,nmtb)                                           
    438 c                                  get output unit number                       
    439       call ugetio(1,nin,iounit)                                                 
    440 c                                  check ier                                   
    441       if (ier.gt.999) go to 25                                                 
    442       if (ier.lt.-32) go to 55                                                 
    443       if (ier.le.128) go to 5                                                   
    444       if (level.lt.1) go to 30                                                 
    445 c                                  print terminal message                       
    446       if (ieqdf.eq.1) write(iounit,35) ier,nameq,ieq,namupk                     
    447       if (ieqdf.eq.0) write(iounit,35) ier,namupk                               
    448       go to 30                                                                 
    449     5 if (ier.le.64) go to 10                                                   
    450       if (level.lt.2) go to 30                                                 
    451 c                                  print warning with fix message               
    452 c      if (ieqdf.eq.1) write(iounit,40) ier,nameq,ieq,namupk                     
    453 c      if (ieqdf.eq.0) write(iounit,40) ier,namupk                               
    454       if (ieqdf.eq.1) continue
    455       if (ieqdf.eq.0) continue
    456       go to 30                                                                 
    457    10 if (ier.le.32) go to 15                                                   
    458 c                                  print warning message                       
    459       if (level.lt.3) go to 30                                                 
    460       if (ieqdf.eq.1) write(iounit,45) ier,nameq,ieq,namupk                     
    461       if (ieqdf.eq.0) write(iounit,45) ier,namupk                               
    462       go to 30                                                                 
    463    15 continue                                                                 
    464 c                                  check for uerset call                       
    465       do 20 i=1,6                                                               
    466          if (namupk(i).ne.namset(i)) go to 25                                   
    467    20 continue                                                                 
    468       levold = level                                                           
    469       level = ier                                                               
    470       ier = levold                                                             
    471       if (level.lt.0) level = 4                                                 
    472       if (level.gt.4) level = 4                                                 
    473       go to 30                                                                 
    474    25 continue                                                                 
    475       if (level.lt.4) go to 30                                                 
    476 c                                  print non-defined message                   
    477       if (ieqdf.eq.1) write(iounit,50) ier,nameq,ieq,namupk                     
    478       if (ieqdf.eq.0) write(iounit,50) ier,namupk                               
    479    30 ieqdf = 0                                                                 
    480       return                                                                   
    481    35 format(19h *** terminal error,10x,7h(ier = ,i3,                           
    482      1       20h) from imsl routine ,6a1,a1,6a1)                               
    483    40 format(27h *** warning with fix error,2x,7h(ier = ,i3,                   
    484      1       20h) from imsl routine ,6a1,a1,6a1)                               
    485    45 format(18h *** warning error,11x,7h(ier = ,i3,                           
    486      1       20h) from imsl routine ,6a1,a1,6a1)                               
    487    50 format(20h *** undefined error,9x,7h(ier = ,i5,                           
    488      1       20h) from imsl routine ,6a1,a1,6a1)                               
    489 c                                                                               
    490 c                                  save p for p = r case                       
    491 c                                    p is the page namupk                       
    492 c                                    r is the routine namupk                   
    493    55 ieqdf = 1                                                                 
    494       do 60 i=1,6                                                               
    495    60 nameq(i) = namupk(i)                                                     
    496    65 return                                                                   
    497       end                         
     423!******************************************************************************
     424!
     425!       subroutine uertst (ier,name)                                             
     426!c                                  specifications for arguments                 
     427!      integer            ier                                                   
     428!      integer            name(2)                                               
     429!c                                  specifications for local variables           
     430!      integer            i,ieq,ieqdf,iounit,level,levold,nameq(6),             
     431!     *                   namset(6),namupk(6),nin,nmtb                           
     432!      data               namset/1hu,1he,1hr,1hs,1he,1ht/                       
     433!      data               nameq/6*1h /                                           
     434!      data               level/4/,ieqdf/0/,ieq/1h=/                             
     435!c                                  unpack name into namupk                     
     436!c                                  first executable statement                   
     437!      call uspkd (name,6,namupk,nmtb)                                           
     438!c                                  get output unit number                       
     439!      call ugetio(1,nin,iounit)                                                 
     440!c                                  check ier                                   
     441!      if (ier.gt.999) go to 25                                                 
     442!      if (ier.lt.-32) go to 55                                                 
     443!      if (ier.le.128) go to 5                                                   
     444!      if (level.lt.1) go to 30                                                 
     445!c                                  print terminal message                       
     446!      if (ieqdf.eq.1) write(iounit,35) ier,nameq,ieq,namupk                     
     447!      if (ieqdf.eq.0) write(iounit,35) ier,namupk                               
     448!      go to 30                                                                 
     449!    5 if (ier.le.64) go to 10                                                   
     450!      if (level.lt.2) go to 30                                                 
     451!c                                  print warning with fix message               
     452!c      if (ieqdf.eq.1) write(iounit,40) ier,nameq,ieq,namupk                     
     453!c      if (ieqdf.eq.0) write(iounit,40) ier,namupk                               
     454!      if (ieqdf.eq.1) continue
     455!      if (ieqdf.eq.0) continue
     456!      go to 30                                                                 
     457!   10 if (ier.le.32) go to 15                                                   
     458!c                                  print warning message                       
     459!      if (level.lt.3) go to 30                                                 
     460!      if (ieqdf.eq.1) write(iounit,45) ier,nameq,ieq,namupk                     
     461!      if (ieqdf.eq.0) write(iounit,45) ier,namupk                               
     462!      go to 30                                                                 
     463!   15 continue                                                                 
     464!c                                  check for uerset call                       
     465!      do 20 i=1,6                                                               
     466!         if (namupk(i).ne.namset(i)) go to 25                                   
     467!   20 continue                                                                 
     468!      levold = level                                                           
     469!      level = ier                                                               
     470!      ier = levold                                                             
     471!      if (level.lt.0) level = 4                                                 
     472!      if (level.gt.4) level = 4                                                 
     473!      go to 30                                                                 
     474!   25 continue                                                                 
     475!      if (level.lt.4) go to 30                                                 
     476!c                                  print non-defined message                   
     477!      if (ieqdf.eq.1) write(iounit,50) ier,nameq,ieq,namupk                     
     478!      if (ieqdf.eq.0) write(iounit,50) ier,namupk                               
     479!   30 ieqdf = 0                                                                 
     480!      return                                                                   
     481!   35 format(19h *** terminal error,10x,7h(ier = ,i3,                           
     482!     1       20h) from imsl routine ,6a1,a1,6a1)                               
     483!   40 format(27h *** warning with fix error,2x,7h(ier = ,i3,                   
     484!     1       20h) from imsl routine ,6a1,a1,6a1)                               
     485!   45 format(18h *** warning error,11x,7h(ier = ,i3,                           
     486!     1       20h) from imsl routine ,6a1,a1,6a1)                               
     487!   50 format(20h *** undefined error,9x,7h(ier = ,i5,                           
     488!     1       20h) from imsl routine ,6a1,a1,6a1)                               
     489!c                                                                               
     490!c                                  save p for p = r case                       
     491!c                                    p is the page namupk                       
     492!c                                    r is the routine namupk                   
     493!   55 ieqdf = 1                                                                 
     494!      do 60 i=1,6                                                               
     495!   60 nameq(i) = namupk(i)                                                     
     496!   65 return                                                                   
     497!      end                         
    498498
    499499
  • trunk/MESOSCALE/LMDZ.MARS/libf_gcm/dyn3d/newstart.F

    r57 r1858  
    840840c=======================================================================
    841841
    842       if (flagps0.eq..false.) then
     842      if (flagps0.eqv..false.) then
    843843        r = 1000.*8.31/mugaz
    844844
Note: See TracChangeset for help on using the changeset viewer.