Changeset 3531 for LMDZ6/trunk/libf


Ignore:
Timestamp:
Jun 6, 2019, 5:08:45 PM (6 years ago)
Author:
Laurent Fairhead
Message:

Replaced STOP statements by a call to abort_physic in phylmd as per ticket #86
Still some work to be done in phylmd subdirectories

Location:
LMDZ6/trunk/libf/phylmd
Files:
17 edited

Legend:

Unmodified
Added
Removed

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

    • Property svn:keywords set to Id
    r3198 r3531  
     1!
     2! $Id$
     3!
    14module ACAMA_GWD_rando_m
    25
    … …  
    120123  !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp)
    121124
    122     CHARACTER (LEN=20) :: modname='flott_gwd_rando'
     125    CHARACTER (LEN=20) :: modname='acama_gwd_rando_m'
    123126    CHARACTER (LEN=80) :: abort_message
    124127
    … …  
    208211
    209212    IF(DELTAT < DTIME)THEN
    210        PRINT *, 'flott_gwd_rando: deltat < dtime!'
    211        STOP 1
     213!       PRINT *, 'flott_gwd_rando: deltat < dtime!'
     214!       STOP 1
     215       abort_message=' deltat < dtime! '
     216       CALL abort_physic(modname,abort_message,1)
    212217    ENDIF
    213218
    214219    IF (KLEV < NW) THEN
    215        PRINT *, 'flott_gwd_rando: you will have problem with random numbers'
    216        STOP 1
     220!       PRINT *, 'flott_gwd_rando: you will have problem with random numbers'
     221!       STOP 1
     222       abort_message=' you will have problem with random numbers'
     223       CALL abort_physic(modname,abort_message,1)
    217224    ENDIF
    218225

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

    • Property svn:keywords set to Id
    r3209 r3531  
     1!
     2! $Id$
     3!
    14SUBROUTINE alpale_th ( dtime, lmax_th, t_seri, cell_area,  &
    25                       cin, s2, n2,  &
    … …  
    6265 REAL umexp  ! expression of (1.-exp(-x))/x valid for all x, especially when x->0
    6366 REAL x
     67     CHARACTER (LEN=20) :: modname='alpale_th'
     68     CHARACTER (LEN=80) :: abort_message
     69     
    6470 umexp(x) = max(sign(1.,x-1.e-3),0.)*(1.-exp(-x))/max(x,1.e-3) + &
    6571            (1.-max(sign(1.,x-1.e-3),0.))*(1.-0.5*x*(1.-x/3.*(1.-0.25*x)))  !!! correct formula            (jyg)
    … …  
    104110             !
    105111             IF (prt_level .GE. 10) THEN
    106                 print *,'cin, ale_bl_stat, alp_bl, alp_bl_stat ', &
     112                WRITE(lunout,*)'cin, ale_bl_stat, alp_bl, alp_bl_stat ', &
    107113                     cin, ale_bl_stat, alp_bl, alp_bl_stat
    108114             ENDIF
    … …  
    122128             !
    123129             IF (prt_level .GE. 10) THEN
    124                 print *,'random_notrig, tau_trig ', &
     130                WRITE(lunout,*)'random_notrig, tau_trig ', &
    125131                     random_notrig, tau_trig
    126                 print *,'s_trig,s2,n2 ', &
     132                WRITE(lunout,*)'s_trig,s2,n2 ', &
    127133                     s_trig,s2,n2
    128134             ENDIF
    … …  
    178184             !
    179185             IF (prt_level .GE. 10) THEN
    180                 print *,'proba_notrig, ale_bl_trig ', &
     186                WRITE(lunout,*)'proba_notrig, ale_bl_trig ', &
    181187                     proba_notrig, ale_bl_trig
    182188             ENDIF
    … …  
    224230        !
    225231        IF (prt_level .GE. 10) THEN
    226            print *,'cin, ale_bl_stat, alp_bl_stat ', &
     232           WRITE(lunout,*)'cin, ale_bl_stat, alp_bl_stat ', &
    227233                cin, ale_bl_stat, alp_bl_stat
    228234        ENDIF
    … …  
    253259        !
    254260        IF (prt_level .GE. 10) THEN
    255            print *,'random_notrig, tau_trig ', &
     261           WRITE(lunout,*)'random_notrig, tau_trig ', &
    256262                random_notrig, tau_trig
    257            print *,'s_trig,s2,n2 ', &
     263           WRITE(lunout,*)'s_trig,s2,n2 ', &
    258264                s_trig,s2,n2
    259265        ENDIF
    … …  
    289295        !
    290296        IF (prt_level .GE. 10) THEN
    291            print *,'proba_notrig, ale_bl_trig ', &
     297           WRITE(lunout,*)'proba_notrig, ale_bl_trig ', &
    292298                proba_notrig, ale_bl_trig
    293299        ENDIF
    … …  
    300306
    301307          IF (prt_level .GE. 10) THEN
    302              print *,'alpale_th: ale_bl_trig, alp_bl_stat, birth_rate ', &
     308             WRITE(lunout,*)'alpale_th: ale_bl_trig, alp_bl_stat, birth_rate ', &
    303309                      ale_bl_trig(1), alp_bl_stat(1), birth_rate(1)
    304310          ENDIF
    … …  
    310316          if (iflag_coupl==2) then
    311317             IF (prt_level .GE. 10) THEN
    312                 print*,'Couplage Thermiques/Emanuel seulement si T<0'
     318                WRITE(lunout,*)'Couplage Thermiques/Emanuel seulement si T<0'
    313319             ENDIF
    314320             do i=1,klon
    … …  
    317323                endif
    318324             enddo
    319     print *,'In order to run with iflag_coupl=2, you have to comment out the following stop'
    320              STOP
     325!    print *,'In order to run with iflag_coupl=2, you have to comment out the following stop'
     326!             STOP
     327             abort_message='In order to run with iflag_coupl=2, you have to comment out the following abort'
     328             CALL abort_physic(modname,abort_message,1)
    321329          endif
    322330   RETURN

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

    r3470 r3531  
    6565  IMPLICIT NONE
    6666      INTEGER :: iflag_phys
    67       INTEGER :: ierr
     67      INTEGER :: ierr
     68      CHARACTER (LEN=20) :: modname='create_etat0_limit_unstruct'
     69      CHARACTER (LEN=80) :: abort_message
     70     
    6871      IF (grid_type==unstructured) THEN
    6972 
    … …  
    8386                CALL MPI_Finalize(ierr)
    8487#endif
    85                 WRITE(lunout,*)   'create_etat0_limit_unstruct, Initial state file are created, all is fine'
    86                 STOP 0
     88                abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine'
     89                CALL abort_physic(modname,abort_message,0)
    8790              ENDIF
    8891!$OMP BARRIER
    89               STOP 'create_etat0_limit_unstruct, Initial state file are created, all is fine'
     92              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine'              CALL abort_physic(modname,abort_message,0)
    9093          ENDIF
    9194        ELSE
    … …  
    102105              ENDIF
    103106!$OMP BARRIER
    104               WRITE(lunout,*)   'create_etat0_limit_unstruct, Initial state file are created, all is fine'
    105               STOP 0
     107              abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine'
     108              CALL abort_physic(modname,abort_message,0)
    106109          ENDIF
    107110        ENDIF

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

    r3471 r3531  
    200200   INTEGER :: ij,ierr, n_extrap
    201201   LOGICAL :: skip
    202    
     202
     203   CHARACTER (len = 50)         :: modname = 'create_limit_unstruct.time_interpolation'
     204   CHARACTER (len = 80)         :: abort_message
     205
    203206 
    204207   IF (is_omp_master) ndays_in=year_len(annee_ref, calendar)
    … …  
    212215     yder = pchsp_95(timeyear, field_in(ij, :), ibeg=2, iend=2, vc_beg=0., vc_end=0.)
    213216     CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr)
    214      if (ierr < 0) stop 1
     217     if (ierr < 0) then
     218        abort_message='error in pchfe_95'
     219        CALL abort_physic(modname,abort_message,1)
     220     endif
    215221     n_extrap = n_extrap + ierr
    216222   END DO

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

    r2520 r3531  
    32983298      integer i,k   
    32993299      real hp_bak(nloc,nd)
     3300      CHARACTER (LEN=20) :: modname='cv30_epmax_fn_cape'
     3301      CHARACTER (LEN=80) :: abort_message
    33003302
    33013303        ! on recalcule ep et hp
    … …  
    33463348           write(*,*) 'clw(i,k)=',clw(i,k)
    33473349           write(*,*) 'cpd,cpv=',cpd,cpv
    3348            stop
     3350           CALL abort_physic(modname,abort_message,0)
    33493351        endif
    33503352       enddo !do k=1,nl

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

    • Property svn:keywords set to Id
    r3198 r3531  
     1!
     2! $Id$
     3!
    14module FLOTT_GWD_rando_m
    25
    … …  
    2023      USE ioipsl_getin_p_mod, ONLY : getin_p
    2124      USE vertical_layers_mod, ONLY : presnivs
     25      CHARACTER (LEN=20) :: modname='flott_gwd_rando'
     26      CHARACTER (LEN=80) :: abort_message
    2227
    2328      include "YOMCST.h"
    … …  
    115120    LOGICAL, SAVE :: firstcall = .TRUE.
    116121  !$OMP THREADPRIVATE(firstcall,gwd_reproductibilite_mpiomp)
    117 
    118     CHARACTER (LEN=20) :: modname='flott_gwd_rando'
    119     CHARACTER (LEN=80) :: abort_message
    120 
    121122
    122123
    … …  
    198199
    199200    IF(DELTAT < DTIME)THEN
    200        PRINT *, 'flott_gwd_rando: deltat < dtime!'
    201        STOP 1
     201       abort_message='flott_gwd_rando: deltat < dtime!'
     202       CALL abort_physic(modname,abort_message,1)
    202203    ENDIF
    203204
    204205    IF (KLEV < NW) THEN
    205        PRINT *, 'flott_gwd_rando: you will have problem with random numbers'
    206        STOP 1
     206       abort_message='flott_gwd_rando: you will have problem with random numbers'
     207       CALL abort_physic(modname,abort_message,1)
    207208    ENDIF
    208209

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

    r3297 r3531  
    7878    !
    7979    INTEGER :: iret, ncid, DimID, VarID, xdmy
     80    CHARACTER (len = 50)     :: modname = 'mo_simple_plumes.sp_setup'
     81    CHARACTER (len = 80)     :: abort_message
     82
    8083    !
    8184    ! ----------
    … …  
    8487       !   
    8588       iret = nf90_open("MACv2.0-SP_v1.nc", NF90_NOWRITE, ncid)
    86        IF (iret /= NF90_NOERR) STOP 'NetCDF File not opened'
     89       IF (iret /= NF90_NOERR) THEN
     90          abort_message='NetCDF File not opened'
     91          CALL abort_physic(modname,abort_message,1)
     92       ENDIF
    8793       !
    8894       ! read dimensions and make sure file conforms to expected size
    … …  
    9096       iret = nf90_inq_dimid(ncid, "plume_number"  , DimId)
    9197       iret = nf90_inquire_dimension(ncid, DimId, len = xdmy)
    92        IF (xdmy /= nplumes) STOP 'NetCDF improperly dimensioned -- plume_number'
     98       IF (xdmy /= nplumes) THEN
     99          abort_message='NetCDF improperly dimensioned -- plume_number'
     100          CALL abort_physic(modname,abort_message,1)
     101       ENDIF
    93102       !
    94103       iret = nf90_inq_dimid(ncid, "plume_feature", DimId)
    95104       iret = nf90_inquire_dimension(ncid, DimId, len = xdmy)
    96        IF (xdmy /= nfeatures) STOP 'NetCDF improperly dimensioned -- plume_feature'
     105       IF (xdmy /= nfeatures) THEN
     106          abort_message='NetCDF improperly dimensioned -- plume_feature'
     107          CALL abort_physic(modname,abort_message,1)
     108       ENDIF
    97109       !
    98110       iret = nf90_inq_dimid(ncid, "year_fr"   , DimId)
    99111       iret = nf90_inquire_dimension(ncid, DimID, len = xdmy)
    100        IF (xdmy /= ntimes) STOP 'NetCDF improperly dimensioned -- year_fr'
     112       IF (xdmy /= ntimes) THEN
     113          abort_message='NetCDF improperly dimensioned -- year_fr'
     114          CALL abort_physic(modname,abort_message,1)
     115       ENDIF
    101116       !
    102117       iret = nf90_inq_dimid(ncid, "years"   , DimId)
    103118       iret = nf90_inquire_dimension(ncid, DimID, len = xdmy)
    104        IF (xdmy /= nyears) STOP 'NetCDF improperly dimensioned -- years'
     119       IF (xdmy /= nyears) THEN
     120          abort_message='NetCDF improperly dimensioned -- years'
     121          CALL abort_physic(modname,abort_message,1)
     122       ENDIF
    105123       !
    106124       ! read variables that define the simple plume climatology
    … …  
    108126       iret = nf90_inq_varid(ncid, "plume_lat", VarId)
    109127       iret = nf90_get_var(ncid, VarID, plume_lat(:), start=(/1/),count=(/nplumes/))
    110        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading plume_lat'
     128       IF (iret /= NF90_NOERR) THEN
     129          abort_message='NetCDF Error reading plume_lat'
     130          CALL abort_physic(modname,abort_message,1)
     131       ENDIF
    111132       iret = nf90_inq_varid(ncid, "plume_lon", VarId)
    112133       iret = nf90_get_var(ncid, VarID, plume_lon(:), start=(/1/),count=(/nplumes/))
    113        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading plume_lon'
     134       IF (iret /= NF90_NOERR) THEN
     135          abort_message='NetCDF Error reading plume_lon'
     136          CALL abort_physic(modname,abort_message,1)
     137       ENDIF
    114138       iret = nf90_inq_varid(ncid, "beta_a"   , VarId)
    115139       iret = nf90_get_var(ncid, VarID, beta_a(:)   , start=(/1/),count=(/nplumes/))
    116        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading beta_a'
     140       IF (iret /= NF90_NOERR) THEN
     141          abort_message='NetCDF Error reading beta_a'
     142          CALL abort_physic(modname,abort_message,1)
     143       ENDIF
    117144       iret = nf90_inq_varid(ncid, "beta_b"   , VarId)
    118145       iret = nf90_get_var(ncid, VarID, beta_b(:)   , start=(/1/),count=(/nplumes/))
    119        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading beta_b'
     146       IF (iret /= NF90_NOERR) THEN
     147          abort_message='NetCDF Error reading beta_b'
     148          CALL abort_physic(modname,abort_message,1)
     149       ENDIF
    120150       iret = nf90_inq_varid(ncid, "aod_spmx" , VarId)
    121151       iret = nf90_get_var(ncid, VarID, aod_spmx(:)  , start=(/1/),count=(/nplumes/))
    122        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading aod_spmx'
     152       IF (iret /= NF90_NOERR) THEN
     153          abort_message='NetCDF Error reading aod_spmx'
     154          CALL abort_physic(modname,abort_message,1)
     155       ENDIF
    123156       iret = nf90_inq_varid(ncid, "aod_fmbg" , VarId)
    124157       iret = nf90_get_var(ncid, VarID, aod_fmbg(:)  , start=(/1/),count=(/nplumes/))
    125        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading aod_fmbg'
     158       IF (iret /= NF90_NOERR) THEN
     159          abort_message='NetCDF Error reading aod_fmbg'
     160          CALL abort_physic(modname,abort_message,1)
     161       ENDIF
    126162       iret = nf90_inq_varid(ncid, "ssa550"   , VarId)
    127163       iret = nf90_get_var(ncid, VarID, ssa550(:)  , start=(/1/),count=(/nplumes/))
    128        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading ssa550'
     164       IF (iret /= NF90_NOERR) THEN
     165          abort_message='NetCDF Error reading ssa550'
     166          CALL abort_physic(modname,abort_message,1)
     167       ENDIF
    129168       iret = nf90_inq_varid(ncid, "asy550"   , VarId)
    130169       iret = nf90_get_var(ncid, VarID, asy550(:)  , start=(/1/),count=(/nplumes/))
    131        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading asy550'
     170       IF (iret /= NF90_NOERR) THEN
     171          abort_message='NetCDF Error reading asy550'
     172          CALL abort_physic(modname,abort_message,1)
     173       ENDIF
    132174       iret = nf90_inq_varid(ncid, "angstrom" , VarId)
    133175       iret = nf90_get_var(ncid, VarID, angstrom(:), start=(/1/),count=(/nplumes/))
    134        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading angstrom'
     176       IF (iret /= NF90_NOERR) THEN
     177          abort_message='NetCDF Error reading angstrom'
     178          CALL abort_physic(modname,abort_message,1)
     179       ENDIF
    135180       !
    136181       iret = nf90_inq_varid(ncid, "sig_lat_W"     , VarId)
    137182       iret = nf90_get_var(ncid, VarID, sig_lat_W(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    138        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading sig_lat_W'
     183       IF (iret /= NF90_NOERR) THEN
     184          abort_message='NetCDF Error reading sig_lat_W'
     185          CALL abort_physic(modname,abort_message,1)
     186       ENDIF
    139187       iret = nf90_inq_varid(ncid, "sig_lat_E"     , VarId)
    140188       iret = nf90_get_var(ncid, VarID, sig_lat_E(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    141        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading sig_lat_E'
     189       IF (iret /= NF90_NOERR) THEN
     190          abort_message='NetCDF Error reading sig_lat_E'
     191          CALL abort_physic(modname,abort_message,1)
     192       ENDIF
    142193       iret = nf90_inq_varid(ncid, "sig_lon_E"     , VarId)
    143194       iret = nf90_get_var(ncid, VarID, sig_lon_E(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    144        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading sig_lon_E'
     195       IF (iret /= NF90_NOERR) THEN
     196          abort_message='NetCDF Error reading sig_lon_E'
     197          CALL abort_physic(modname,abort_message,1)
     198       ENDIF
    145199       iret = nf90_inq_varid(ncid, "sig_lon_W"     , VarId)
    146200       iret = nf90_get_var(ncid, VarID, sig_lon_W(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    147        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading sig_lon_W'
     201       IF (iret /= NF90_NOERR) THEN
     202          abort_message='NetCDF Error reading sig_lon_W'
     203          CALL abort_physic(modname,abort_message,1)
     204       ENDIF
    148205       iret = nf90_inq_varid(ncid, "theta"         , VarId)
    149206       iret = nf90_get_var(ncid, VarID, theta(:,:)        , start=(/1,1/),count=(/nfeatures,nplumes/))
    150        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading theta'
     207       IF (iret /= NF90_NOERR) THEN
     208          abort_message='NetCDF Error reading theta'
     209          CALL abort_physic(modname,abort_message,1)
     210       ENDIF
    151211       iret = nf90_inq_varid(ncid, "ftr_weight"    , VarId)
    152212       iret = nf90_get_var(ncid, VarID, ftr_weight(:,:)   , start=(/1,1/),count=(/nfeatures,nplumes/))
    153        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading plume_lat'
     213       IF (iret /= NF90_NOERR) THEN
     214          abort_message='NetCDF Error reading plume_lat'
     215          CALL abort_physic(modname,abort_message,1)
     216       ENDIF
    154217       iret = nf90_inq_varid(ncid, "year_weight"   , VarId)
    155218       iret = nf90_get_var(ncid, VarID, year_weight(:,:)  , start=(/1,1/),count=(/nyears,nplumes   /))
    156        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading year_weight'
     219       IF (iret /= NF90_NOERR) THEN
     220          abort_message='NetCDF Error reading year_weight'
     221          CALL abort_physic(modname,abort_message,1)
     222       ENDIF
    157223       iret = nf90_inq_varid(ncid, "ann_cycle"     , VarId)
    158224       iret = nf90_get_var(ncid, VarID, ann_cycle(:,:,:)  , start=(/1,1,1/),count=(/nfeatures,ntimes,nplumes/))
    159        IF (iret /= NF90_NOERR) STOP 'NetCDF Error reading ann_cycle'
     225       IF (iret /= NF90_NOERR) THEN
     226          abort_message='NetCDF Error reading ann_cycle'
     227          CALL abort_physic(modname,abort_message,1)
     228       ENDIF
    160229       !
    161230       iret = nf90_close(ncid)

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

    • Property svn:keywords changed from Author Date Id Revision to Id
    r1907 r3531  
     1!
     2! $Id$
     3!
    14MODULE mod_synchro_omp
    25
    … …  
    2124  IMPLICIT NONE
    2225  LOGICAL :: out
     26  CHARACTER (LEN=20) :: modname='synchro_omp'
     27  CHARACTER (LEN=80) :: abort_message
    2328 
    2429    out=.FALSE.
    … …  
    4651
    4752    IF (exit_omp/=0) THEN
    48       STOP 'synchro_omp'
     53       abort_message='synchro_omp'
     54       CALL abort_physic(modname,abort_message,1)
    4955    ENDIF
    5056

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

    r3435 r3531  
    112112    REAL paire
    113113
     114    ! Local
     115    CHARACTER (LEN=20) :: modname='phyaqua'
     116    CHARACTER (LEN=80) :: abort_message
     117
    114118
    115119    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    128132    IF (klon/=nlon) THEN
    129133      WRITE (*, *) 'iniaqua: klon=', klon, ' nlon=', nlon
    130       STOP 'probleme de dimensions dans iniaqua'
     134      abort_message= 'probleme de dimensions dans iniaqua'
     135      CALL abort_physic(modname,abort_message,1)
    131136    END IF
    132137    CALL phys_state_var_init(read_climoz)
    … …  
    812817    PARAMETER (nlat_max=72)
    813818    REAL x_anom_sst(nlat_max)
    814 
    815     IF (klon/=nlon) STOP 'probleme de dimensions dans iniaqua'
     819    CHARACTER (LEN=20) :: modname='profil_sst'
     820    CHARACTER (LEN=80) :: abort_message
     821
     822    IF (klon/=nlon) THEN
     823       abort_message='probleme de dimensions dans profil_sst'
     824       CALL abort_physic(modname,abort_message,1)
     825    ENDIF
    816826    WRITE (*, *) ' profil_sst: type_profil=', type_profil
    817827    DO i = 1, 360

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

    r3522 r3531  
    12701270          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
    12711271               '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
    1272           STOP
     1272          abort_message='see above'
     1273          CALL abort_physic(modname,abort_message,1)
    12731274       ENDIF
    12741275

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

    • Property svn:keywords set to Id
    r3467 r3531  
    602602       IF (lessivage .AND. type_trac .EQ. 'inca') THEN
    603603          CALL abort_physic('phytrac', 'lessivage=T config_inca=inca impossible',1)
    604           STOP
     604!          STOP
    605605       ENDIF
    606606       !

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

    r3436 r3531  
    1515    USE aero_mod
    1616    USE dimphy
     17    USE print_control_mod, ONLY: prt_level,lunout
    1718#ifdef CPP_XIOS
    1819    USE xios
    … …  
    6162    data alpha_strat_wave/3.36780953,3.34667683,3.20444202,3.0293026,2.82108808/
    6263
     64    CHARACTER (len = 20)                      :: modname = 'readaerosolstrato'
     65    CHARACTER (len = 80)                      :: abort_message
     66
    6367!--------------------------------------------------------
    6468
    … …  
    7276
    7377    IF (nbands.NE.2) THEN
    74         print *,'nbands doit etre egal a 2 dans readaerosolstrat'
    75         STOP
     78        abort_message='nbands doit etre egal a 2 dans readaerosolstrat'
     79        CALL abort_physic(modname,abort_message,1)
    7680    ENDIF
    7781
    … …  
    8286    n_lev = size(lev)
    8387    IF (n_lev.NE.klev) THEN
    84        print *,'Le nombre de niveaux n est pas egal a klev'
    85        STOP
     88       abort_message='Le nombre de niveaux n est pas egal a klev'
     89       CALL abort_physic(modname,abort_message,1)
    8690    ENDIF
    8791
    … …  
    8993    CALL nf95_gw_var(ncid_in, varid, latitude)
    9094    n_lat = size(latitude)
    91     print *, 'LAT aerosol strato=', n_lat, latitude
     95    WRITE(lunout,*) 'LAT aerosol strato=', n_lat, latitude
    9296    IF (grid_type/=unstructured) THEN
    9397      IF (n_lat.NE.nbp_lat) THEN
    94          print *,'Le nombre de lat n est pas egal a nbp_lat'
    95          STOP
     98         abort_message='Le nombre de lat n est pas egal a nbp_lat'
     99         CALL abort_physic(modname,abort_message,1)
    96100      ENDIF
    97101    ENDIF
    … …  
    101105    n_lon = size(longitude)
    102106    IF (grid_type/=unstructured) THEN
    103       print *, 'LON aerosol strato=', n_lon, longitude
     107      WRITE(lunout,*) 'LON aerosol strato=', n_lon, longitude
    104108      IF (n_lon.NE.nbp_lon) THEN
    105          print *,'Le nombre de lon n est pas egal a nbp_lon'
    106          STOP
     109         abort_message='Le nombre de lon n est pas egal a nbp_lon'
     110         CALL abort_physic(modname,abort_message,1)
    107111      ENDIF
    108112    ENDIF
    … …  
    111115    CALL nf95_gw_var(ncid_in, varid, time)
    112116    n_month = size(time)
    113     print *, 'TIME aerosol strato=', n_month, time
     117    WRITE(lunout,*) 'TIME aerosol strato=', n_month, time
    114118    IF (n_month.NE.12) THEN
    115        print *,'Le nombre de month n est pas egal a 12'
    116        STOP
     119       abort_message='Le nombre de month n est pas egal a 12'
     120       CALL abort_physic(modname,abort_message,1)
    117121    ENDIF
    118122
    … …  
    124128    CALL nf95_inq_varid(ncid_in, "TAUSTRAT", varid)
    125129    ncerr = nf90_get_var(ncid_in, varid, tauaerstrat)
    126     print *,'code erreur readaerosolstrato=', ncerr, varid
     130    WRITE(lunout,*) 'code erreur readaerosolstrato=', ncerr, varid
    127131
    128132    CALL nf95_close(ncid_in)
    … …  
    130134!---select the correct month
    131135    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
    132       print *,'probleme avec le mois dans readaerosolstrat =', mth_cur
     136     WRITE(lunout,*) 'probleme avec le mois dans readaerosolstrat =', mth_cur
    133137    ENDIF
    134138    tauaerstrat_mois(:,:,:) = tauaerstrat(:,:,:,mth_cur)

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

    r3298 r3531  
    1515    USE mod_phys_lmdz_para, ONLY: scatter
    1616    USE phys_state_var_mod, ONLY: chl_con
     17    USE print_control_mod, ONLY: prt_level,lunout
    1718
    1819    IMPLICIT NONE
    … …  
    4546
    4647!--------------------------------------------------------
     48    CHARACTER (len = 20)  :: modname = 'readchlorophyll'
     49    CHARACTER (len = 80)  :: abort_message
    4750
    4851!--only read file if beginning of run or start of new month
    … …  
    5659    CALL nf95_gw_var(ncid_in, varid, longitude)
    5760    n_lon = size(longitude)
    58 !    print *, 'LON chlorophyll=', n_lon, longitude
    5961    IF (n_lon.NE.nbp_lon) THEN
    60        print *,'Le nombre de lon n est pas egal a nbp_lon'
    61        STOP
     62       abort_message='Le nombre de lon n est pas egal a nbp_lon'
     63       CALL abort_physic(modname,abort_message,1)
    6264    ENDIF
    6365
    … …  
    6567    CALL nf95_gw_var(ncid_in, varid, latitude)
    6668    n_lat = size(latitude)
    67 !    print *, 'LAT chlorophyll=', n_lat, latitude
    6869    IF (n_lat.NE.nbp_lat) THEN
    69        print *,'Le nombre de lat n est pas egal a jnbp_lat'
    70        STOP
     70       abort_message='Le nombre de lat n est pas egal a jnbp_lat'
     71       CALL abort_physic(modname,abort_message,1)
    7172    ENDIF
    7273
    … …  
    7475    CALL nf95_gw_var(ncid_in, varid, time)
    7576    n_month = size(time)
    76 !    print *, 'TIME aerosol strato=', n_month, time
    7777    IF (n_month.NE.12) THEN
    78        print *,'Le nombre de month n est pas egal a 12'
    79        STOP
     78       abort_message='Le nombre de month n est pas egal a 12'
     79       CALL abort_physic(modname,abort_message,1)
    8080    ENDIF
    8181
    … …  
    8787    CALL nf95_inq_varid(ncid_in, "CHL", varid)
    8888    ncerr = nf90_get_var(ncid_in, varid, chlorocon)
    89     print *,'code erreur readchlorophyll=', ncerr, varid
     89    WRITE(lunout,*)'code erreur readchlorophyll=', ncerr, varid
    9090
    9191    CALL nf95_close(ncid_in)
    … …  
    9393!---select the correct month
    9494    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
    95       print *,'probleme avec le mois dans readchlorophyll =', mth_cur
     95      WRITE(lunout,*)'probleme avec le mois dans readchlorophyll =', mth_cur
    9696    ENDIF
    9797    chlorocon_mois(:,:) = chlorocon(:,:,mth_cur)
    … …  
    100100    CALL grid2dTo1d_glo(chlorocon_mois,chlorocon_mois_glo)
    101101
    102     print *,"chrolophyll current month",mth_cur
     102    WRITE(lunout,*)"chrolophyll current month",mth_cur
    103103    DO i=1,klon_glo
    104104!      if(isnan(chlorocon_mois_glo(i)))then ! isnan() is not in the Fortran standard...

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

    r2585 r3531  
    22        module m_simu_airs
    33
     4        USE print_control_mod, ONLY: prt_level,lunout
     5         
    46        implicit none
    57
    6         real, parameter :: tau_thresh = 0.05 ! seuil nuages detectables
    7         real, parameter :: p_thresh = 445.   ! seuil nuages hauts
    8         real, parameter :: em_min = 0.2      ! seuils nuages semi-transp
    9         real, parameter :: em_max = 0.85
    10         real, parameter :: undef = 999.
     8        REAL, PARAMETER :: tau_thresh = 0.05 ! seuil nuages detectables
     9        REAL, PARAMETER :: p_thresh = 445.   ! seuil nuages hauts
     10        REAL, PARAMETER :: em_min = 0.2      ! seuils nuages semi-transp
     11        REAL, PARAMETER :: em_max = 0.85
     12        REAL, PARAMETER :: undef = 999.
    1113
    1214        contains
    1315
    14         real function search_tropopause(P,T,alt,N) result(P_tropo)
     16        REAL function search_tropopause(P,T,alt,N) result(P_tropo)
    1517! this function searches for the tropopause pressure in [hPa].
    1618! The search is based on ideology described in
    … …  
    1820! GRL, 30(20) 2042, doi:10.1029/2003GL018240, 2003
    1921
    20         integer N,i,i_lev,first_point,exit_flag,i_dir
    21         real P(N),T(N),alt(N),slope(N)
    22         real P_min, P_max, slope_limit,slope_2km, &
     22        INTEGER N,i,i_lev,first_point,exit_flag,i_dir
     23        REAL P(N),T(N),alt(N),slope(N)
     24        REAL P_min, P_max, slope_limit,slope_2km, &
    2325     & delta_alt_limit,tmp,delta_alt
    24         parameter(P_min=75.0, P_max=470.0)   ! hPa
    25         parameter(slope_limit=0.002)         ! 2 K/km converted to K/m
    26         parameter(delta_alt_limit=2000.0)    ! 2000 meters
     26        PARAMETER(P_min=75.0, P_max=470.0)   ! hPa
     27        PARAMETER(slope_limit=0.002)         ! 2 K/km converted to K/m
     28        PARAMETER(delta_alt_limit=2000.0)    ! 2000 meters
    2729
    2830        do i=1,N-1
    … …  
    9395
    9496     
    95         integer :: i, n, nss
    96 
    97         integer, intent(in) :: len_cs
    98         real, dimension(:), intent(in) :: rneb_cs, temp_cs
    99         real, dimension(:), intent(in) :: emis_cs, iwco_cs, rad_cs
    100         real, dimension(:), intent(in) :: pres_cs, dz_cs, rhodz_cs
    101 
    102         real, intent(out) :: cc_tot_cs, cc_hc_cs, cc_hist_cs, &
     97        INTEGER :: i, n, nss
     98
     99        INTEGER, intent(in) :: len_cs
     100        REAL, DIMENSION(:), intent(in) :: rneb_cs, temp_cs
     101        REAL, DIMENSION(:), intent(in) :: emis_cs, iwco_cs, rad_cs
     102        REAL, DIMENSION(:), intent(in) :: pres_cs, dz_cs, rhodz_cs
     103
     104        REAL, intent(out) :: cc_tot_cs, cc_hc_cs, cc_hist_cs, &
    103105     & cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs, &
    104106     & pcld_hc_cs, tcld_hc_cs, em_hc_cs, iwp_hc_cs, &
    … …  
    109111     & deltaz_hc_cs, deltaz_hist_cs, rad_hist_cs
    110112
    111         real, dimension(len_cs) :: rneb_ord
    112         real :: rneb_min
    113 
    114         real, dimension(:), allocatable :: s, s_hc, s_hist, rneb_max
    115         real, dimension(:), allocatable :: sCb, sThCi, sAnv
    116         real, dimension(:), allocatable :: iwp_ss, pcld_ss, tcld_ss,&
     113        REAL, DIMENSION(len_cs) :: rneb_ord
     114        REAL :: rneb_min
     115
     116        REAL, DIMENSION(:), allocatable :: s, s_hc, s_hist, rneb_max
     117        REAL, DIMENSION(:), allocatable :: sCb, sThCi, sAnv
     118        REAL, DIMENSION(:), allocatable :: iwp_ss, pcld_ss, tcld_ss,&
    117119     & emis_ss
    118         real, dimension(:), allocatable :: deltaz_ss, rad_ss
    119 
    120 
    121         write(*,*) 'dans cloud_structure'
     120        REAL, DIMENSION(:), allocatable :: deltaz_ss, rad_ss
     121
     122        CHARACTER (len = 50)      :: modname = 'simu_airs.cloud_structure'
     123        CHARACTER (len = 160)     :: abort_message
     124       
     125
     126        write(lunout,*) 'dans cloud_structure'
    122127
    123128        call ordonne(len_cs, rneb_cs, rneb_ord)
    … …  
    300305        if (cc_tot_cs .gt. maxval(rneb_cs) .and. &
    301306     & abs(cc_tot_cs-maxval(rneb_cs)) .gt. 1.e-4 )  then
    302         write(*,*) 'cc_tot_cs > max rneb_cs'
    303         write(*,*) cc_tot_cs, maxval(rneb_cs)
    304         STOP
     307          WRITE(abort_message,*) 'cc_tot_cs > max rneb_cs', cc_tot_cs, maxval(rneb_cs)
     308          CALL abort_physic(modname,abort_message,1)
    305309        endif
    306310
    307311        if (iwp_hc_cs .lt. 0.) then
    308         write(*,*) 'cloud_structure:'
    309         write(*,*) 'iwp_hc_cs < 0'
    310         STOP
     312          abort_message= 'cloud_structure: iwp_hc_cs < 0'
     313          CALL abort_physic(modname,abort_message,1)
    311314        endif
    312315 
    … …  
    316319        subroutine normal_undef(num, den)
    317320
    318         real, intent(in) :: den
    319         real, intent(inout) :: num
     321        REAL, intent(in) :: den
     322        REAL, intent(inout) :: num
    320323
    321324        if (den .ne. 0) then
    … …  
    330333        subroutine normal2_undef(res,num,den)
    331334
    332         real, intent(in) :: den
    333         real, intent(in) :: num
    334         real, intent(out) :: res
     335        REAL, intent(in) :: den
     336        REAL, intent(in) :: num
     337        REAL, intent(out) :: res
    335338
    336339        if (den .ne. 0.) then
    … …  
    350353     & emis, pcld, tcld, iwp, deltaz, rad)
    351354
    352         integer, intent(in) :: len_cs
    353         real, dimension(len_cs), intent(in) :: rneb_cs, temp_cs
    354         real, dimension(len_cs), intent(in) :: emis_cs, iwco_cs, &
     355        INTEGER, intent(in) :: len_cs
     356        REAL, DIMENSION(len_cs), intent(in) :: rneb_cs, temp_cs
     357        REAL, DIMENSION(len_cs), intent(in) :: emis_cs, iwco_cs, &
    355358     & rneb_ord
    356         real, dimension(len_cs), intent(in) :: pres_cs, dz_cs, rad_cs
    357         real, dimension(len_cs), intent(in) :: rhodz_cs
    358         real, dimension(len_cs) :: tau_cs, w
    359         real, intent(in) :: rnebmax
    360         real, intent(inout) :: stot, shc, shist
    361         real, intent(inout) :: sCb, sThCi, sAnv
    362         real, intent(out) :: emis, pcld, tcld, iwp, deltaz, rad
    363 
    364         integer :: i, ideb, ibeg, iend, nuage, visible
    365         real :: som, som_tau, som_iwc, som_dz, som_rad, tau
     359        REAL, DIMENSION(len_cs), intent(in) :: pres_cs, dz_cs, rad_cs
     360        REAL, DIMENSION(len_cs), intent(in) :: rhodz_cs
     361        REAL, DIMENSION(len_cs) :: tau_cs, w
     362        REAL, intent(in) :: rnebmax
     363        REAL, intent(inout) :: stot, shc, shist
     364        REAL, intent(inout) :: sCb, sThCi, sAnv
     365        REAL, intent(out) :: emis, pcld, tcld, iwp, deltaz, rad
     366
     367        INTEGER :: i, ideb, ibeg, iend, nuage, visible
     368        REAL :: som, som_tau, som_iwc, som_dz, som_rad, tau
     369
     370        CHARACTER (len = 50)      :: modname = 'simu_airs.sous_section'
     371        CHARACTER (len = 160)     :: abort_message
    366372
    367373
    … …  
    491497
    492498        if (iwp .lt. 0.) then
    493         write(*,*) 'ideb iwp =', ideb, iwp
    494         STOP
     499          WRITE(abort_message,*) 'ideb iwp =', ideb, iwp
     500          CALL abort_physic(modname,abort_message,1)
    495501        endif
    496502
    497503        if (deltaz .lt. 0.) then
    498         write(*,*) 'ideb deltaz =', ideb, deltaz
    499         STOP
     504          WRITE(abort_message,*)'ideb deltaz =', ideb, deltaz
     505          CALL abort_physic(modname,abort_message,1)
    500506        endif
    501507
    502508        if (emis .lt. 0.048 .and. emis .ne. 0.) then
    503         write(*,*) 'ideb emis =', ideb, emis
    504         STOP
     509          WRITE(abort_message,*) 'ideb emis =', ideb, emis
     510          CALL abort_physic(modname,abort_message,1)
    505511        endif
    506512
    … …  
    511517     & visible, w)
    512518
    513         integer, intent(in) :: ibeg, iend
    514         real, intent(in) :: som_tau
    515 
    516         integer, intent(inout) :: visible
    517         real, dimension(:), intent(inout) :: w
    518 
    519         integer :: i
     519        INTEGER, intent(in) :: ibeg, iend
     520        REAL, intent(in) :: som_tau
     521
     522        INTEGER, intent(inout) :: visible
     523        REAL, DIMENSION(:), intent(inout) :: w
     524
     525        INTEGER :: i
    520526
    521527
    … …  
    553559     & som_tau, som_iwc, som_dz, som_rad)
    554560
    555         integer, intent(in) :: ibeg, iend
    556         real, dimension(:), intent(in) :: tau_cs, iwco_cs, temp_cs
    557         real, dimension(:), intent(in) :: pres_cs, dz_cs, rad_cs
    558         real, dimension(:), intent(in) :: rhodz_cs
    559         real, intent(out) :: som_tau, som_iwc, som_dz, som_rad
    560         real , intent(out) :: pcld, tcld
    561 
    562         integer :: i, ibase, imid
     561        INTEGER, intent(in) :: ibeg, iend
     562        REAL, DIMENSION(:), intent(in) :: tau_cs, iwco_cs, temp_cs
     563        REAL, DIMENSION(:), intent(in) :: pres_cs, dz_cs, rad_cs
     564        REAL, DIMENSION(:), intent(in) :: rhodz_cs
     565        REAL, intent(out) :: som_tau, som_iwc, som_dz, som_rad
     566        REAL , intent(out) :: pcld, tcld
     567
     568        INTEGER :: i, ibase, imid
     569
     570        CHARACTER (len = 50)      :: modname = 'simu_airs.caract'
     571        CHARACTER (len = 160)     :: abort_message
    563572
    564573! Somme des epaisseurs optiques et des contenus en glace sur le nuage
    … …  
    585594
    586595        if (som_dz .ne. 0.) then
    587         som_rad = som_rad/som_dz
     596          som_rad = som_rad/som_dz
    588597        else
    589         write(*,*) 'som_dez = 0 STOP'
    590         write(*,*) 'ibeg, iend =', ibeg, iend
    591         do i = ibeg, iend
    592         write(*,*) dz_cs(i), rhodz_cs(i)
    593         enddo
    594         STOP
     598          write(*,*) 'som_dez = 0 STOP'
     599          write(*,*) 'ibeg, iend =', ibeg, iend
     600          do i = ibeg, iend
     601             write(*,*) dz_cs(i), rhodz_cs(i)
     602          enddo
     603          abort_message='see above'
     604          CALL abort_physic(modname,abort_message,1)
    595605        endif
    596606
    … …  
    611621        subroutine topbot(ideb,w,ibeg,iend)
    612622
    613         integer, intent(in) :: ideb
    614         real, dimension(:), intent(in) :: w
    615         integer, intent(out) :: ibeg, iend
    616 
    617         integer :: i, itest
     623        INTEGER, intent(in) :: ideb
     624        REAL, DIMENSION(:), intent(in) :: w
     625        INTEGER, intent(out) :: ibeg, iend
     626
     627        INTEGER :: i, itest
    618628
    619629        itest = 0
    … …  
    642652        subroutine ordonne(len_cs, rneb_cs, rneb_ord)
    643653
    644         integer, intent(in) :: len_cs
    645         real, dimension(:), intent(in) :: rneb_cs
    646         real, dimension(:), intent(out) :: rneb_ord
    647 
    648         integer :: i, j, ind_min
    649 
    650         real, dimension(len_cs) :: rneb
    651         real :: rneb_max
     654        INTEGER, intent(in) :: len_cs
     655        REAL, DIMENSION(:), intent(in) :: rneb_cs
     656        REAL, DIMENSION(:), intent(out) :: rneb_ord
     657
     658        INTEGER :: i, j, ind_min
     659
     660        REAL, DIMENSION(len_cs) :: rneb
     661        REAL :: rneb_max
    652662
    653663
    … …  
    689699       USE dimphy
    690700
    691        real, dimension(klev), intent(in) :: rneb_1D, temp_1D, emis_1D, &
     701       REAL, DIMENSION(klev), intent(in) :: rneb_1D, temp_1D, emis_1D, &
    692702     & iwcon_1D, rad_1D
    693         real, dimension(klev), intent(in) :: pres, dz, rhodz_1D
    694         real, intent(out) :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
    695         real, intent(out) :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
    696         real, intent(out) :: em_hc_mesh, pcld_hc_mesh, tcld_hc_mesh, &
     703        REAL, DIMENSION(klev), intent(in) :: pres, dz, rhodz_1D
     704        REAL, intent(out) :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
     705        REAL, intent(out) :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
     706        REAL, intent(out) :: em_hc_mesh, pcld_hc_mesh, tcld_hc_mesh, &
    697707     & iwp_hc_mesh
    698708
    699         real, intent(out) :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
    700         real, intent(out) :: pcld_ThCi_mesh, tcld_ThCi_mesh, &
     709        REAL, intent(out) :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
     710        REAL, intent(out) :: pcld_ThCi_mesh, tcld_ThCi_mesh, &
    701711     & em_ThCi_mesh
    702         real, intent(out) :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
    703 
    704         real, intent(out) :: em_hist_mesh, iwp_hist_mesh, rad_hist_mesh
    705         real, intent(out) :: deltaz_hc_mesh, deltaz_hist_mesh
    706 
    707         real, dimension(:), allocatable :: rneb_cs, temp_cs, emis_cs, &
     712        REAL, intent(out) :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
     713
     714        REAL, intent(out) :: em_hist_mesh, iwp_hist_mesh, rad_hist_mesh
     715        REAL, intent(out) :: deltaz_hc_mesh, deltaz_hist_mesh
     716
     717        REAL, DIMENSION(:), allocatable :: rneb_cs, temp_cs, emis_cs, &
    708718     & iwco_cs
    709         real, dimension(:), allocatable :: pres_cs, dz_cs, rad_cs, &
     719        REAL, DIMENSION(:), allocatable :: pres_cs, dz_cs, rad_cs, &
    710720     & rhodz_cs
    711721
    712         integer :: i,j,l
    713         integer :: ltop, itop, ibot, num_cs, N_cs, len_cs, ics
    714 
    715         real :: som_emi_hc,som_pcl_hc,som_tcl_hc,som_iwp_hc,som_hc,&
     722        INTEGER :: i,j,l
     723        INTEGER :: ltop, itop, ibot, num_cs, N_cs, len_cs, ics
     724
     725        REAL :: som_emi_hc,som_pcl_hc,som_tcl_hc,som_iwp_hc,som_hc,&
    716726     & som_hist
    717         real :: som_emi_hist, som_iwp_hist, som_deltaz_hc, &
     727        REAL :: som_emi_hist, som_iwp_hist, som_deltaz_hc, &
    718728     & som_deltaz_hist
    719         real :: som_rad_hist
    720         real :: som_Cb, som_ThCi, som_Anv
    721         real :: som_emi_Cb, som_tcld_Cb, som_pcld_Cb
    722         real :: som_emi_Anv, som_tcld_Anv, som_pcld_Anv
    723         real :: som_emi_ThCi, som_tcld_ThCi, som_pcld_ThCi
    724         real :: tsom_tot, tsom_hc, tsom_hist
    725         real :: prod, prod_hh
    726 
    727         real :: cc_tot_cs, cc_hc_cs, cc_hist_cs
    728         real :: cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs
    729         real :: pcld_hc_cs, tcld_hc_cs
    730         real :: em_hc_cs, iwp_hc_cs, deltaz_hc_cs
    731         real :: pcld_Cb_cs, tcld_Cb_cs, em_Cb_cs
    732         real :: pcld_ThCi_cs, tcld_ThCi_cs, em_ThCi_cs
    733         real :: pcld_Anv_cs, tcld_Anv_cs, em_Anv_cs
    734         real :: em_hist_cs, iwp_hist_cs, deltaz_hist_cs, rad_hist_cs
    735 
    736         real, dimension(klev) :: test_tot, test_hc, test_hist
    737         real, dimension(klev) :: test_pcld, test_tcld, test_em, test_iwp
    738 
     729        REAL :: som_rad_hist
     730        REAL :: som_Cb, som_ThCi, som_Anv
     731        REAL :: som_emi_Cb, som_tcld_Cb, som_pcld_Cb
     732        REAL :: som_emi_Anv, som_tcld_Anv, som_pcld_Anv
     733        REAL :: som_emi_ThCi, som_tcld_ThCi, som_pcld_ThCi
     734        REAL :: tsom_tot, tsom_hc, tsom_hist
     735        REAL :: prod, prod_hh
     736
     737        REAL :: cc_tot_cs, cc_hc_cs, cc_hist_cs
     738        REAL :: cc_Cb_cs, cc_ThCi_cs, cc_Anv_cs
     739        REAL :: pcld_hc_cs, tcld_hc_cs
     740        REAL :: em_hc_cs, iwp_hc_cs, deltaz_hc_cs
     741        REAL :: pcld_Cb_cs, tcld_Cb_cs, em_Cb_cs
     742        REAL :: pcld_ThCi_cs, tcld_ThCi_cs, em_ThCi_cs
     743        REAL :: pcld_Anv_cs, tcld_Anv_cs, em_Anv_cs
     744        REAL :: em_hist_cs, iwp_hist_cs, deltaz_hist_cs, rad_hist_cs
     745
     746        REAL, DIMENSION(klev) :: test_tot, test_hc, test_hist
     747        REAL, DIMENSION(klev) :: test_pcld, test_tcld, test_em, test_iwp
     748
     749        CHARACTER (len = 50)      :: modname = 'simu_airs.sim_mesh'
     750        CHARACTER (len = 160)     :: abort_message
     751       
    739752
    740753        do j = 1, klev
    741         write(*,*) 'simu_airs, j, rneb_1D =', rneb_1D(j)
     754          WRITE(lunout,*) 'simu_airs, j, rneb_1D =', rneb_1D(j)
    742755        enddo
    743756
    … …  
    9911004       if (cc_tot_mesh .gt. tsom_tot .and. &
    9921005     & abs(cc_tot_mesh-tsom_tot) .gt. 1.e-4) then
    993         write(*,*) 'cc_tot_mesh > tsom_tot'
    994         write(*,*) cc_tot_mesh, tsom_tot
    995         STOP
     1006           WRITE(abort_message,*)'cc_tot_mesh > tsom_tot', cc_tot_mesh, tsom_tot
     1007           CALL abort_physic(modname,abort_message,1)
    9961008        endif
    9971009
    9981010        if (cc_tot_mesh .lt. maxval(test_tot(1:N_CS)) .and. &
    9991011     & abs(cc_tot_mesh-maxval(test_tot(1:N_CS))) .gt. 1.e-4) then
    1000         write(*,*) 'cc_tot_mesh < max'
    1001         write(*,*) cc_tot_mesh, maxval(test_tot(1:N_CS))
    1002         STOP
     1012           WRITE(abort_message,*) 'cc_tot_mesh < max', cc_tot_mesh, maxval(test_tot(1:N_CS))
     1013           CALL abort_physic(modname,abort_message,1)
    10031014        endif
    10041015
    10051016        if (cc_hc_mesh .gt. tsom_hc .and. &
    10061017     & abs(cc_hc_mesh-tsom_hc) .gt. 1.e-4) then
    1007         write(*,*) 'cc_hc_mesh > tsom_hc'
    1008         write(*,*) cc_hc_mesh, tsom_hc
    1009         STOP
     1018           WRITE(abort_message,*) 'cc_hc_mesh > tsom_hc', cc_hc_mesh, tsom_hc
     1019           CALL abort_physic(modname,abort_message,1)
    10101020        endif
    10111021
    10121022        if (cc_hc_mesh .lt. maxval(test_hc(1:N_CS)) .and. &
    10131023     & abs(cc_hc_mesh-maxval(test_hc(1:N_CS))) .gt. 1.e-4) then
    1014         write(*,*) 'cc_hc_mesh < max'
    1015         write(*,*) cc_hc_mesh, maxval(test_hc(1:N_CS))
    1016         STOP
     1024           WRITE(abort_message,*) 'cc_hc_mesh < max', cc_hc_mesh, maxval(test_hc(1:N_CS))
     1025           CALL abort_physic(modname,abort_message,1)
    10171026        endif
    10181027
    10191028        if (cc_hist_mesh .gt. tsom_hist .and. &
    10201029     & abs(cc_hist_mesh-tsom_hist) .gt. 1.e-4) then
    1021         write(*,*) 'cc_hist_mesh > tsom_hist'
    1022         write(*,*) cc_hist_mesh, tsom_hist
    1023         STOP
     1030           WRITE(abort_message,*) 'cc_hist_mesh > tsom_hist', cc_hist_mesh, tsom_hist
     1031           CALL abort_physic(modname,abort_message,1)
    10241032        endif
    10251033
    10261034        if (cc_hist_mesh .lt. 0.) then
    1027         write(*,*) 'cc_hist_mesh < 0'
    1028         write(*,*) cc_hist_mesh
    1029         STOP
     1035           WRITE(abort_message,*) 'cc_hist_mesh < 0', cc_hist_mesh
     1036           CALL abort_physic(modname,abort_message,1)
    10301037        endif
    10311038
    … …  
    10351042     & maxval(test_pcld(1:N_CS)) .ne. 999. &
    10361043     & .and. minval(test_pcld(1:N_CS)) .ne. 999.) then
    1037         write(*,*) 'pcld_hc_mesh est faux'
    1038         write(*,*) pcld_hc_mesh, maxval(test_pcld(1:N_CS)), &
     1044           WRITE(abort_message,*) 'pcld_hc_mesh est faux', pcld_hc_mesh, maxval(test_pcld(1:N_CS)), &
    10391045     & minval(test_pcld(1:N_CS))
    1040         STOP
     1046           CALL abort_physic(modname,abort_message,1)
    10411047        endif
    10421048
    … …  
    10461052     & maxval(test_tcld(1:N_CS)) .ne. 999. &
    10471053     & .and. minval(test_tcld(1:N_CS)) .ne. 999.) then
    1048         write(*,*) 'tcld_hc_mesh est faux'
    1049         write(*,*) tcld_hc_mesh, maxval(test_tcld(1:N_CS)), &
    1050      & minval(test_tcld(1:N_CS))
     1054           WRITE(abort_message,*) 'tcld_hc_mesh est faux', tcld_hc_mesh, maxval(test_tcld(1:N_CS)), &
     1055                & minval(test_tcld(1:N_CS))
     1056           CALL abort_physic(modname,abort_message,1)
    10511057        endif
    10521058
    … …  
    10561062     & minval(test_em(1:N_CS)) .ne. 999. .and. &
    10571063     & maxval(test_em(1:N_CS)) .ne. 999. ) then
    1058         write(*,*) 'em_hc_mesh est faux'
    1059         write(*,*) em_hc_mesh, maxval(test_em(1:N_CS)), &
     1064           WRITE(abort_message,*) 'em_hc_mesh est faux', em_hc_mesh, maxval(test_em(1:N_CS)), &
    10601065     & minval(test_em(1:N_CS))
    1061         STOP
     1066           CALL abort_physic(modname,abort_message,1)
    10621067        endif
    10631068
    … …  
    11011106        subroutine test_bornes(sx,x,bsup,binf)
    11021107
    1103         real, intent(in) :: x, bsup, binf
     1108        REAL, intent(in) :: x, bsup, binf
    11041109        character*14, intent(in) :: sx
     1110        CHARACTER (len = 50)      :: modname = 'simu_airs.test_bornes'
     1111        CHARACTER (len = 160)     :: abort_message
    11051112
    11061113        if (x .gt. bsup .or. x .lt. binf) then
    1107         write(*,*) sx, 'est faux'
    1108         write(*,*) sx, x
    1109         STOP
     1114          WRITE(abort_message,*) sx, 'est faux', sx, x
     1115          CALL abort_physic(modname,abort_message,1)
    11101116        endif
    11111117 
    … …  
    11341140        include "YOMCST.h"
    11351141
    1136         integer,intent(in) :: itap
    1137 
    1138         real, dimension(klon,klev), intent(in) :: &
     1142        INTEGER,intent(in) :: itap
     1143
     1144        REAL, DIMENSION(klon,klev), intent(in) :: &
    11391145     & rneb_airs, temp_airs, cldemi_airs, iwcon0_airs, &
    11401146     & rad_airs, geop_airs, pplay_airs, paprs_airs
    11411147
    1142        real, dimension(klon,klev) :: &
     1148       REAL, DIMENSION(klon,klev) :: &
    11431149     & rhodz_airs, rho_airs, iwcon_airs
    11441150
    1145         real, dimension(klon),intent(out) :: alt_tropo
    1146 
    1147         real, dimension(klev) :: rneb_1D, temp_1D, &
     1151        REAL, DIMENSION(klon),intent(out) :: alt_tropo
     1152
     1153        REAL, DIMENSION(klev) :: rneb_1D, temp_1D, &
    11481154     & emis_1D, rad_1D, pres_1D, alt_1D, &
    11491155     & rhodz_1D, dz_1D, iwcon_1D
    11501156
    1151         integer :: i, j
    1152 
    1153         real :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
    1154         real :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
    1155         real :: pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh
    1156         real :: em_hist_mesh, iwp_hist_mesh
    1157         real :: deltaz_hc_mesh, deltaz_hist_mesh, rad_hist_mesh
    1158         real :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
    1159         real :: pcld_ThCi_mesh, tcld_ThCi_mesh, em_ThCi_mesh
    1160         real :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
    1161 
    1162         real, dimension(klon),intent(out) :: map_prop_hc, map_prop_hist
    1163         real, dimension(klon),intent(out) :: map_emis_hc, map_iwp_hc
    1164         real, dimension(klon),intent(out) :: map_deltaz_hc, map_pcld_hc
    1165         real, dimension(klon),intent(out) :: map_tcld_hc
    1166         real, dimension(klon),intent(out) :: map_emis_Cb,map_pcld_Cb,map_tcld_Cb
    1167         real, dimension(klon),intent(out) :: &
     1157        INTEGER :: i, j
     1158
     1159        REAL :: cc_tot_mesh, cc_hc_mesh, cc_hist_mesh
     1160        REAL :: cc_Cb_mesh, cc_ThCi_mesh, cc_Anv_mesh
     1161        REAL :: pcld_hc_mesh, tcld_hc_mesh, em_hc_mesh, iwp_hc_mesh
     1162        REAL :: em_hist_mesh, iwp_hist_mesh
     1163        REAL :: deltaz_hc_mesh, deltaz_hist_mesh, rad_hist_mesh
     1164        REAL :: pcld_Cb_mesh, tcld_Cb_mesh, em_Cb_mesh
     1165        REAL :: pcld_ThCi_mesh, tcld_ThCi_mesh, em_ThCi_mesh
     1166        REAL :: pcld_Anv_mesh, tcld_Anv_mesh, em_Anv_mesh
     1167
     1168        REAL, DIMENSION(klon),intent(out) :: map_prop_hc, map_prop_hist
     1169        REAL, DIMENSION(klon),intent(out) :: map_emis_hc, map_iwp_hc
     1170        REAL, DIMENSION(klon),intent(out) :: map_deltaz_hc, map_pcld_hc
     1171        REAL, DIMENSION(klon),intent(out) :: map_tcld_hc
     1172        REAL, DIMENSION(klon),intent(out) :: map_emis_Cb,map_pcld_Cb,map_tcld_Cb
     1173        REAL, DIMENSION(klon),intent(out) :: &
    11681174     & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi
    1169         real, dimension(klon),intent(out) :: &
     1175        REAL, DIMENSION(klon),intent(out) :: &
    11701176     & map_emis_Anv,map_pcld_Anv,map_tcld_Anv
    1171         real, dimension(klon),intent(out) :: &
     1177        REAL, DIMENSION(klon),intent(out) :: &
    11721178     & map_emis_hist,map_iwp_hist,map_deltaz_hist,&
    11731179     & map_rad_hist
    1174        real, dimension(klon),intent(out) :: map_ntot,map_hc,map_hist
    1175        real, dimension(klon),intent(out) :: map_Cb,map_ThCi,map_Anv
     1180        REAL, DIMENSION(klon),intent(out) :: map_ntot,map_hc,map_hist
     1181        REAL, DIMENSION(klon),intent(out) :: map_Cb,map_ThCi,map_Anv
    11761182 
    11771183 

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

    r3435 r3531  
    106106    REAL,INTENT(IN) :: omeg
    107107
     108    CHARACTER (len = 20) :: modname = 'slab_heat_transp'
     109    CHARACTER (len = 80) :: abort_message
     110   
    108111    ! Sanity check on dimensions
    109112    if ((ip1jm.ne.((nbp_lon+1)*(nbp_lat-1))).or. &
    110113        (ip1jmp1.ne.((nbp_lon+1)*nbp_lat))) then
    111       write(*,*) "ini_slab_transp_geom Error: wrong array sizes"
    112       stop
     114      abort_message="ini_slab_transp_geom Error: wrong array sizes"
     115      CALL abort_physic(modname,abort_message,1)
    113116    endif
    114117! Allocations could be done only on master process/thread...
    … …  
    925928  INTEGER j,ifield,ig
    926929
     930  CHARACTER (len = 20)                      :: modname = 'slab_heat_transp'
     931  CHARACTER (len = 80)                      :: abort_message
     932
    927933  ! Sanity check:
    928934  IF(klon_glo.NE.2+(jm-2)*(im-1)) THEN
    929     WRITE(*,*) "gr_dyn_fi error, wrong sizes"
    930     STOP
     935    abort_message="gr_dyn_fi error, wrong sizes"
     936    CALL abort_physic(modname,abort_message,1)
    931937  ENDIF
    932938

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

    r3453 r3531  
    161161    LOGICAL, PARAMETER :: readco2ff=.TRUE., readco2bb=.FALSE.
    162162
     163    CHARACTER (len = 20) :: modname = 'tracco2i.co2_emissions'
     164    CHARACTER (len = 80) :: abort_message
     165
    163166    IF (debutphy) THEN
    164167
    … …  
    182185        n_glo = size(vector)
    183186        IF (n_glo.NE.klon_glo) THEN
    184            PRINT *,'sflx_lmdz_co2_ff: le nombre de points n est pas egal a klon_glo'
    185            STOP
     187           abort_message='sflx_lmdz_co2_ff: le nombre de points n est pas egal a klon_glo'
     188           CALL abort_physic(modname,abort_message,1)
    186189        ENDIF
    187190
    … …  
    190193        n_month = size(time)
    191194        IF (n_month.NE.12) THEN
    192            PRINT *,'sflx_lmdz_co2_ff: le nombre de month n est pas egal a 12'
    193            STOP
     195           abort_message='sflx_lmdz_co2_ff: le nombre de month n est pas egal a 12'
     196           CALL abort_physic(modname,abort_message,1)
    194197        ENDIF
    195198
    … …  
    214217      n_glo = size(vector)
    215218      IF (n_glo.NE.klon_glo) THEN
    216          PRINT *,'sflx_lmdz_co2_bb: le nombre de points n est pas egal a klon_glo'
    217          STOP
     219         abort_message='sflx_lmdz_co2_bb: le nombre de points n est pas egal a klon_glo'
     220         CALL abort_physic(modname,abort_message,1)
    218221      ENDIF
    219222
    … …  
    222225      n_month = size(time)
    223226      IF (n_month.NE.12) THEN
    224          PRINT *,'sflx_lmdz_co2_bb: le nombre de month n est pas egal a 12'
    225          STOP
     227         abort_message='sflx_lmdz_co2_bb: le nombre de month n est pas egal a 12'
     228         CALL abort_physic(modname,abort_message,1)
    226229      ENDIF
    227230

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

    r3435 r3531  
    152152  !$OMP THREADPRIVATE(firstcall)
    153153
     154  CHARACTER (len = 20) :: modname = 'yamada4'
     155  CHARACTER (len = 80) :: abort_message
     156
    154157
    155158
    … …  
    199202    ENDIF
    200203
    201     PRINT*,'YAMADA4 RIc, RIfc, Sm_min, Alpha_min',ric,rifc,seuilsm,seuilalpha
     204    WRITE(lunout,*)'YAMADA4 RIc, RIfc, Sm_min, Alpha_min',ric,rifc,seuilsm,seuilalpha
    202205    firstcall = .FALSE.
    203206    CALL getin_p('lmixmin',lmixmin)
    … …  
    216219
    217220  IF (.NOT. (iflag_pbl>=6 .AND. iflag_pbl<=12)) THEN
    218     STOP 'probleme de coherence dans appel a MY'
     221    abort_message='probleme de coherence dans appel a MY'
     222    CALL abort_physic(modname,abort_message,1)
    219223  END IF
    220224
    … …  
    537541
    538542  ELSE
    539     STOP 'Cas nom prevu dans yamada4'
     543     abort_message='Cas nom prevu dans yamada4'
     544     CALL abort_physic(modname,abort_message,1)
    540545
    541546  END IF ! Fin du cas 8
    … …  
    590595
    591596  IF (prt_level>1) THEN
    592     PRINT *, 'YAMADA4 0'
     597    WRITE(lunout,*) 'YAMADA4 0'
    593598  END IF
    594599
    … …  
    660665
    661666  IF (prt_level>1) THEN
    662     PRINT *, 'YAMADA4 1'
     667    WRITE(lunout,*)'YAMADA4 1'
    663668  END IF !(prt_level>1) THEN
    664669
Note: See TracChangeset for help on using the changeset viewer.