Ignore:
Timestamp:
Oct 9, 2012, 3:35:26 PM (12 years ago)
Author:
Laurent Fairhead
Message:

Version testing basée sur la r1628

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1628

Location:
LMDZ5/branches/testing
Files:
1 deleted
29 edited
1 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3dpar/bands.F90

    r1279 r1665  
    9393   SUBROUTINE  Set_Bands
    9494     USE parallel
    95 #ifdef CPP_EARTH
    96 ! Ehouarn: what follows is only related to // physics; for now only for Earth
     95#ifdef CPP_PHYS
     96! Ehouarn: what follows is only related to // physics
    9797     USE mod_phys_lmdz_para, ONLY : jj_para_begin,jj_para_end
    9898#endif
    … …  
    106106      enddo
    107107         
    108 #ifdef CPP_EARTH
    109 ! Ehouarn: what follows is only related to // physics; for now only for Earth         
     108#ifdef CPP_PHYS
    110109      do i=0,MPI_Size-1
    111110        jj_Nb_physic(i)=jj_para_end(i)-jj_para_begin(i)+1
    … …  
    332331    subroutine AdjustBands_physic
    333332      use times
    334 #ifdef CPP_EARTH
    335 ! Ehouarn: what follows is only related to // physics; for now only for Earth
     333#ifdef CPP_PHYS
     334! Ehouarn: what follows is only related to // physics
    336335      USE mod_phys_lmdz_para, only : klon_mpi_para_nb
    337336#endif
    … …  
    359358      medium=medium/mpi_size     
    360359      NbTot=0
    361 #ifdef CPP_EARTH
    362 ! Ehouarn: what follows is only related to // physics; for now only for Earth
     360#ifdef CPP_PHYS
    363361      do i=0,mpi_size-1
    364362        Inc(i)=nint(klon_mpi_para_nb(i)*(medium-value(i))/value(i))

  • LMDZ5/branches/testing/libf/dyn3dpar/calfis_p.F

    r1407 r1665  
    2727     $                  pdqfi,
    2828     $                  pdpsfi)
    29 #ifdef CPP_EARTH
    30 ! Ehouarn: For now, calfis_p needs Earth physics
    31 c
    32 c    Auteur :  P. Le Van, F. Hourdin
    33 c   .........
     29#ifdef CPP_PHYS
     30! If using physics
    3431      USE dimphy
    3532      USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
    … …  
    146143      REAL clesphy0( longcles )
    147144
    148 #ifdef CPP_EARTH
     145#ifdef CPP_PHYS
     146! Ehouarn: for now calfis_p needs some informations from physics to compile
    149147c    Local variables :
    150148c    -----------------
    … …  
    222220      PARAMETER(ntetaSTD=3)
    223221      REAL rtetaSTD(ntetaSTD)
    224       DATA rtetaSTD/350., 380., 405./
     222      DATA rtetaSTD/350., 380., 405./ ! Earth-specific values, beware !!
    225223      REAL PVteta(klon,ntetaSTD)
    226224     
    … …  
    489487
    490488
    491       IF (is_sequential) THEN
    492 c
     489      IF (is_sequential.and.(planet_type=="earth")) THEN
     490#ifdef CPP_PHYS
     491! PVtheta calls tetalevel, which is in the physics
    493492cIM calcul PV a teta=350, 380, 405K
    494493        CALL PVtheta(ngridmx,llm,pucov,pvcov,pteta,
    … …  
    496495     $           ntetaSTD,rtetaSTD,PVteta)
    497496c
     497#endif
    498498      ENDIF
    499499
    … …  
    627627c$OMP BARRIER
    628628     
    629       if (planet_type=="earth") then
    630 #ifdef CPP_EARTH
    631 
    632629!$OMP MASTER
    633630!      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
    … …  
    639636      zdqfic_omp(:,:,:)=0.
    640637
     638      if (planet_type=="earth") then
     639#ifdef CPP_PHYS
    641640      do isplit=1,nsplit_phys
    642641
    … …  
    687686      enddo
    688687
     688#endif
     689! of #ifdef CPP_PHYS
     690      endif !of if (planet_type=="earth")
     691
    689692      zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
    690693      zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
    691694      zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys
    692695      zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
    693 
    694 #endif
    695       endif !of if (planet_type=="earth")
    696696c$OMP BARRIER
    697697
    … …  
    11101110      firstcal = .FALSE.
    11111111
    1112 #else
    1113       write(lunout,*)
    1114      & "calfis_p: for now can only work with parallel physics"
    1115       stop
    1116 #endif
    1117 ! of #ifdef CPP_EARTH
     1112#else 
     1113      write(lunout,*) 
     1114     & "calfis_p: for now can only work with parallel physics" 
     1115      stop 
     1116#endif 
     1117! of #ifdef CPP_PHYS
    11181118      RETURN
    11191119      END

  • LMDZ5/branches/testing/libf/dyn3dpar/ce0l.F90

    r1664 r1665  
    1919  USE dimphy
    2020  USE comgeomphy
    21   USE mod_phys_lmdz_para
     21  USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root
    2222  USE mod_const_mpi
    2323  USE infotrac
    … …  
    3131  IMPLICIT NONE
    3232#ifndef CPP_EARTH
     33#include "iniprint.h"
    3334  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
    3435#else
    … …  
    4243#include "temps.h"
    4344#include "logic.h"
     45#ifdef CPP_MPI
     46      include 'mpif.h'
     47#endif
     48
    4449  INTEGER, PARAMETER            :: longcles=20
     50  INTEGER                       :: ierr
    4551  REAL,    DIMENSION(longcles)  :: clesphy0
    4652  REAL,    DIMENSION(iip1,jjp1) :: masque
    … …  
    5056  CALL conf_gcm( 99, .TRUE. , clesphy0 )
    5157
     58#ifdef CPP_MPI
    5259  CALL init_mpi
     60#endif
    5361
    5462  CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    … …  
    115123  END IF
    116124 
     125#ifdef CPP_MPI
    117126!$OMP MASTER
    118   CALL finalize_parallel
     127  CALL MPI_FINALIZE(ierr)
     128  IF (ierr /= 0) CALL abort_gcm('ce0l','Error in MPI_FINALIZE',1)
    119129!$OMP END MASTER
     130#endif
    120131
    121132#endif

  • LMDZ5/branches/testing/libf/dyn3dpar/comvert.h

    r1520 r1665  
    99     &               aps(llm),bps(llm),scaleheight
    1010
    11       common/comverti/disvert_type
     11      common/comverti/disvert_type, pressure_exner
    1212
    1313      real ap     ! hybrid pressure contribution at interlayers
    … …  
    3030                           !     using 'z2sig.def' (or 'esasig.def) file
    3131
     32      logical pressure_exner
     33!     compute pressure inside layers using Exner function, else use mean
     34!     of pressure values at interfaces
     35
    3236 !-----------------------------------------------------------------------

  • LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F

    r1664 r1665  
    167167      nday = 10
    168168      CALL getin('nday',nday)
     169
     170!Config  Key  = starttime
     171!Config  Desc = Heure de depart de la simulation
     172!Config  Def  = 0
     173!Config  Help = Heure de depart de la simulation
     174!Config         en jour
     175      starttime = 0
     176      CALL getin('starttime',starttime)
    169177
    170178!Config  Key  = day_step

  • LMDZ5/branches/testing/libf/dyn3dpar/control_mod.F90

    r1502 r1665  
    1010  IMPLICIT NONE
    1111
    12   REAL    :: periodav
     12  REAL    :: periodav, starttime
    1313  INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
    1414  INTEGER :: iconser,iecri,dissip_period,iphysiq,iecrimoy

  • LMDZ5/branches/testing/libf/dyn3dpar/disvert.F90

    r1524 r1665  
    44
    55  ! Auteur : P. Le Van
     6
     7  use new_unit_m, only: new_unit
     8  use ioipsl, only: getin
    69
    710  IMPLICIT NONE
    … …  
    2629  real zk, zkm1, dzk1, dzk2, k0, k1
    2730
    28   INTEGER l
     31  INTEGER l, unit
    2932  REAL dsigmin
    3033  REAL alpha, beta, deltaz
    31   INTEGER iostat
    3234  REAL x
    3335  character(len=*),parameter :: modname="disvert"
    3436
     37  character(len=6):: vert_sampling
     38  ! (allowed values are "param", "tropo", "strato" and "read")
     39
    3540  !-----------------------------------------------------------------------
     41
     42  print *, "Call sequence information: disvert"
    3643
    3744  ! default scaleheight is 8km for earth
    3845  scaleheight=8.
    3946
    40   OPEN(99, file='sigma.def', status='old', form='formatted', iostat=iostat)
     47  vert_sampling = merge("strato", "tropo ", ok_strato) ! default value
     48  call getin('vert_sampling', vert_sampling)
     49  print *, 'vert_sampling = ' // vert_sampling
    4150
    42   IF (iostat == 0) THEN
    43      ! cas 1 on lit les options dans sigma.def:
     51  select case (vert_sampling)
     52  case ("param")
     53     ! On lit les options dans sigma.def:
     54     OPEN(99, file='sigma.def', status='old', form='formatted')
    4455     READ(99, *) scaleheight ! hauteur d'echelle 8.
    4556     READ(99, *) deltaz ! epaiseur de la premiere couche 0.04
    … …  
    6879
    6980     sig(llm+1)=0.
    70 
    71      DO l = 1, llm
    72         dsig(l) = sig(l)-sig(l+1)
    73      end DO
    74   ELSE
    75      if (ok_strato) then
    76         if (llm==39) then
    77            dsigmin=0.3
    78         else if (llm==50) then
    79            dsigmin=1.
    80         else
    81            write(lunout,*) trim(modname), &
    82            ' ATTENTION discretisation z a ajuster'
    83            dsigmin=1.
    84         endif
    85         write(lunout,*) trim(modname), &
    86         ' Discretisation verticale DSIGMIN=',dsigmin
    87      endif
    88 
     81  case("tropo")
    8982     DO l = 1, llm
    9083        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
    91 
    92         IF (ok_strato) THEN
    93            dsig(l) =(dsigmin + 7. * SIN(x)**2) &
    94                 *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
    95         ELSE
    96            dsig(l) = 1.0 + 7.0 * SIN(x)**2
    97         ENDIF
     84        dsig(l) = 1.0 + 7.0 * SIN(x)**2
    9885     ENDDO
    9986     dsig = dsig / sum(dsig)
    … …  
    10289        sig(l) = sig(l+1) + dsig(l)
    10390     ENDDO
    104   ENDIF
     91  case("strato")
     92     if (llm==39) then
     93        dsigmin=0.3
     94     else if (llm==50) then
     95        dsigmin=1.
     96     else
     97        write(lunout,*) trim(modname), ' ATTENTION discretisation z a ajuster'
     98        dsigmin=1.
     99     endif
     100     WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
     101
     102     DO l = 1, llm
     103        x = 2*asin(1.) * (l - 0.5) / (llm + 1)
     104        dsig(l) =(dsigmin + 7. * SIN(x)**2) &
     105             *(0.5*(1.-tanh(1.*(x-asin(1.))/asin(1.))))**2
     106     ENDDO
     107     dsig = dsig / sum(dsig)
     108     sig(llm+1) = 0.
     109     DO l = llm, 1, -1
     110        sig(l) = sig(l+1) + dsig(l)
     111     ENDDO
     112  case("read")
     113     call new_unit(unit)
     114     open(unit, file="hybrid.txt", status="old", action="read", &
     115          position="rewind")
     116     read(unit, fmt=*) ! skip title line
     117     do l = 1, llm + 1
     118        read(unit, fmt=*) sig(l)
     119     end do
     120     close(unit)
     121  case default
     122     call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
     123  END select
    105124
    106125  DO l=1, llm

  • LMDZ5/branches/testing/libf/dyn3dpar/dynetat0.F

    r1421 r1665  
    119119      day_ini = tab_cntrl(30)
    120120      itau_dyn = tab_cntrl(31)
     121      start_time = tab_cntrl(32)
    121122c   .................................................................
    122123c

  • LMDZ5/branches/testing/libf/dyn3dpar/dynredem.F

    r1664 r1665  
    120120       tab_cntrl(30) = REAL(iday_end)
    121121       tab_cntrl(31) = REAL(itau_dyn + itaufin)
     122c start_time: start_time of simulation (not necessarily 0.)
     123       tab_cntrl(32) = start_time
    122124c
    123125c    .........................................................

  • LMDZ5/branches/testing/libf/dyn3dpar/dynredem_p.F

    r1664 r1665  
    120120       tab_cntrl(30) =  REAL(iday_end)
    121121       tab_cntrl(31) =  REAL(itau_dyn + itaufin)
     122c start_time: start_time of simulation (not necessarily 0.)
     123       tab_cntrl(32) = start_time
    122124c
    123125c    .........................................................

  • LMDZ5/branches/testing/libf/dyn3dpar/etat0_netcdf.F90

    r1520 r1665  
    251251!*******************************************************************************
    252252  CALL pression(ip1jmp1, ap, bp, psol, p3d)
    253   if (disvert_type.eq.1) then
     253  if (pressure_exner) then
    254254    CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
    255   else ! we assume that we are in the disvert_type==2 case
     255  else
    256256    CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y)
    257257  endif

  • LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb.F

    r1520 r1665  
    5656      ! Sanity check
    5757      if (firstcall) then
    58         ! check that vertical discretization is compatible
    59         ! with this routine
    60         if (disvert_type.ne.1) then
    61           call abort_gcm(modname,
    62      &     "this routine should only be called if disvert_type==1",42)
    63         endif
    64        
    6558        ! sanity checks for Shallow Water case (1 vertical layer)
    6659        if (llm.eq.1) then

  • LMDZ5/branches/testing/libf/dyn3dpar/exner_hyb_p.F

    r1664 r1665  
    6060      ! Sanity check
    6161      if (firstcall) then
    62         ! check that vertical discretization is compatible
    63         ! with this routine
    64         if (disvert_type.ne.1) then
    65           call abort_gcm(modname,
    66      &     "this routine should only be called if disvert_type==1",42)
    67         endif
    68        
    6962        ! sanity checks for Shallow Water case (1 vertical layer)
    7063        if (llm.eq.1) then

  • LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu.F

    r1520 r1665  
    5353      ! Sanity check
    5454      if (firstcall) then
    55         ! check that vertical discretization is compatible
    56         ! with this routine
    57         if (disvert_type.ne.2) then
    58           call abort_gcm(modname,
    59      &     "this routine should only be called if disvert_type==2",42)
    60         endif
    61        
    6255        ! sanity checks for Shallow Water case (1 vertical layer)
    6356        if (llm.eq.1) then

  • LMDZ5/branches/testing/libf/dyn3dpar/exner_milieu_p.F

    r1664 r1665  
    5656      ! Sanity check
    5757      if (firstcall) then
    58         ! check that vertical discretization is compatible
    59         ! with this routine
    60         if (disvert_type.ne.2) then
    61           call abort_gcm(modname,
    62      &     "this routine should only be called if disvert_type==2",42)
    63         endif
    64        
    6558        ! sanity checks for Shallow Water case (1 vertical layer)
    6659        if (llm.eq.1) then

  • LMDZ5/branches/testing/libf/dyn3dpar/filtreg_p.F

    r1146 r1665  
    208208               IF( ifiltre.EQ.-2 )   THEN
    209209                  DO j = jdfil,jffil
     210#ifdef BLAS
    210211                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
    211212     &                    matrinvn(1,1,j), iim,
    212213     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
    213214     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     215#else
     216                     champ_fft(:,j-jdfil+1,:)
     217     &                    =matmul(matrinvn(:,:,j),champ_loc(:iim,j,:))
     218#endif
    214219                  ENDDO
    215220                 
    216221               ELSE IF ( griscal )     THEN
    217222                  DO j = jdfil,jffil
     223#ifdef BLAS
    218224                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
    219225     &                    matriceun(1,1,j), iim,
    220226     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
    221227     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     228#else
     229                     champ_fft(:,j-jdfil+1,:)
     230     &                    =matmul(matriceun(:,:,j),champ_loc(:iim,j,:))
     231#endif
    222232                  ENDDO
    223233                 
    224234               ELSE
    225235                  DO j = jdfil,jffil
     236#ifdef BLAS
    226237                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
    227238     &                    matricevn(1,1,j), iim,
    228239     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
    229240     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     241#else
     242                     champ_fft(:,j-jdfil+1,:)
     243     &                    =matmul(matricevn(:,:,j),champ_loc(:iim,j,:))
     244#endif
    230245                  ENDDO
    231246                 
    … …  
    236251               IF( ifiltre.EQ.-2 )   THEN
    237252                  DO j = jdfil,jffil
     253#ifdef BLAS
    238254                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
    239255     &                    matrinvs(1,1,j-jfiltsu+1), iim,
    240256     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
    241257     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     258#else
     259                     champ_fft(:,j-jdfil+1,:)
     260     &                    =matmul(matrinvs(:,:,j-jfiltsu+1),
     261     &                            champ_loc(:iim,j,:))
     262#endif
    242263                  ENDDO
    243264                 
    … …  
    245266                 
    246267                  DO j = jdfil,jffil
     268#ifdef BLAS
    247269                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
    248270     &                    matriceus(1,1,j-jfiltsu+1), iim,
    249271     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
    250272     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     273#else
     274                     champ_fft(:,j-jdfil+1,:)
     275     &                    =matmul(matriceus(:,:,j-jfiltsu+1),
     276     &                            champ_loc(:iim,j,:))
     277#endif
    251278                  ENDDO
    252279                 
    … …  
    254281                 
    255282                  DO j = jdfil,jffil
     283#ifdef BLAS
    256284                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
    257285     &                    matricevs(1,1,j-jfiltsv+1), iim,
    258286     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
    259287     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     288#else
     289                     champ_fft(:,j-jdfil+1,:)
     290     &                    =matmul(matricevs(:,:,j-jfiltsv+1),
     291     &                            champ_loc(:iim,j,:))
     292#endif
    260293                  ENDDO
    261294                 

  • LMDZ5/branches/testing/libf/dyn3dpar/gcm.F

    r1664 r1665  
    2020      USE control_mod
    2121
    22 ! Ehouarn: for now these only apply to Earth:
    23 #ifdef CPP_EARTH
     22#ifdef CPP_PHYS
    2423      USE mod_grid_phy_lmdz
    2524      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
    … …  
    8786
    8887      REAL zdtvr
    89 c      INTEGER nbetatmoy, nbetatdem,nbetat
    90       INTEGER nbetatmoy, nbetatdem
    9188
    9289c   variables dynamiques
    … …  
    189186      call ini_getparam("out.def")
    190187      call Read_Distrib
    191 ! Ehouarn : temporarily (?) keep this only for Earth
    192       if (planet_type.eq."earth") then
    193 #ifdef CPP_EARTH
     188
     189#ifdef CPP_PHYS
    194190        CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
    195191#endif
    196       endif ! of if (planet_type.eq."earth")
    197192      CALL set_bands
    198 #ifdef CPP_EARTH
    199 ! Ehouarn: For now only Earth physics is parallel
     193#ifdef CPP_PHYS
    200194      CALL Init_interface_dyn_phys
    201195#endif
    … …  
    209203c$OMP END PARALLEL
    210204
    211 ! Ehouarn : temporarily (?) keep this only for Earth
    212       if (planet_type.eq."earth") then
    213 #ifdef CPP_EARTH
     205#ifdef CPP_PHYS
    214206c$OMP PARALLEL
    215207      call InitComgeomphy
    216208c$OMP END PARALLEL
    217209#endif
    218       endif ! of if (planet_type.eq."earth")
    219210
    220211c-----------------------------------------------------------------------
    … …  
    323314C on remet le calendrier à zero si demande
    324315c
     316      IF (start_time /= starttime) then
     317        WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le'
     318     &,' fichier restart ne correspond pas à celle lue dans le run.def'
     319        IF (raz_date == 1) then
     320          WRITE(lunout,*)'Je prends l''heure lue dans run.def'
     321          start_time = starttime
     322        ELSE
     323          WRITE(lunout,*)'Je m''arrete'
     324          CALL abort
     325        ENDIF
     326      ENDIF
    325327      IF (raz_date == 1) THEN
    326328        annee_ref = anneeref
    … …  
    390392#endif
    391393
    392 c  nombre d'etats dans les fichiers demarrage et histoire
    393       nbetatdem = nday / iecri
    394       nbetatmoy = nday / periodav + 1
    395394
    396395      if (iflag_phys.eq.1) then
    … …  
    445444         WRITE(lunout,*)
    446445     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
    447 ! Earth:
    448          if (planet_type.eq."earth") then
    449 #ifdef CPP_EARTH
     446! Physics:
     447#ifdef CPP_PHYS
    450448         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
    451449     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    452450#endif
    453          endif ! of if (planet_type.eq."earth")
    454451         call_iniphys=.false.
    455452      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
    … …  
    484481 301  FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
    485482 302  FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
     483#endif
     484
     485#ifdef CPP_PHYS
     486! Create start file (startphy.nc) and boundary conditions (limit.nc)
     487! for the Earth verstion
     488       if (iflag_phys>=100) then
     489          call iniaqua(ngridmx,latfi,lonfi,iflag_phys)
     490       endif
    486491#endif
    487492

  • LMDZ5/branches/testing/libf/dyn3dpar/gr_dyn_fi_p.F

    r1279 r1665  
    33!
    44      SUBROUTINE gr_dyn_fi_p(nfield,im,jm,ngrid,pdyn,pfi)
    5 #ifdef CPP_EARTH
     5#ifdef CPP_PHYS
    66! Interface with parallel physics,
    7 ! for now this routine only works with Earth physics
    87      USE mod_interface_dyn_phys
    98      USE dimphy
    … …  
    4039      ENDDO
    4140c$OMP END DO NOWAIT
    42 #else
    43       write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
    44      &   "without parallelized physics"
    45       stop
    4641#endif
    47 ! of #ifdef CPP_EARTH
     42! of #ifdef CPP_PHYS
    4843      RETURN
    4944      END

  • LMDZ5/branches/testing/libf/dyn3dpar/gr_fi_dyn_p.F

    r1279 r1665  
    33!
    44      SUBROUTINE gr_fi_dyn_p(nfield,ngrid,im,jm,pfi,pdyn)
    5 #ifdef CPP_EARTH
     5#ifdef CPP_PHYS
    66! Interface with parallel physics,
    7 ! for now this routine only works with Earth physics
    87      USE mod_interface_dyn_phys
    98      USE dimphy
    … …  
    5251      ENDDO
    5352c$OMP END DO NOWAIT
    54 #else
    55       write(lunout,*) "gr_fi_dyn_p : This routine should not be called",
    56      &   "without parallelized physics"
    57       stop
    5853#endif
    59 ! of #ifdef CPP_EARTH
     54! of #ifdef CPP_PHYS
    6055      RETURN
    6156      END

  • LMDZ5/branches/testing/libf/dyn3dpar/guide_p_mod.F90

    r1520 r1665  
    455455!       Calcul niveaux pression milieu de couches
    456456        CALL pression_p( ip1jmp1, ap, bp, ps, p )
    457         if (disvert_type==1) then
     457        if (pressure_exner) then
    458458          CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
    459459        else
    … …  
    755755    ELSE
    756756        CALL pression_p( ip1jmp1, ap, bp, psi, p )
    757         if (disvert_type==1) then
     757        if (pressure_exner) then
    758758          CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
    759         else ! we assume that we are in the disvert_type==2 case
     759        else
    760760          CALL exner_milieu_p(ip1jmp1,psi,p,beta,pks,pk,pkf)
    761761        endif

  • LMDZ5/branches/testing/libf/dyn3dpar/iniacademic.F90

    r1664 r1665  
    222222
    223223        CALL pression ( ip1jmp1, ap, bp, ps, p       )
    224         if (disvert_type.eq.1) then
     224        if (pressure_exner) then
    225225          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    226         elseif (disvert_type.eq.2) then
     226        else
    227227          call exner_milieu(ip1jmp1,ps,p,beta,pks,pk,pkf)
    228         else
    229           write(abort_message,*) "Wrong value for disvert_type: ", &
    230                               disvert_type
    231           call abort_gcm(modname,abort_message,0)
    232228        endif
    233229        CALL massdair(p,masse)

  • LMDZ5/branches/testing/libf/dyn3dpar/inidissip.F90

    r1502 r1665  
    2828! Local variables:
    2929  REAL fact,zvert(llm),zz
    30   REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
     30  REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
     31  real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm)
    3132  REAL ullm,vllm,umin,vmin,zhmin,zhmax
    32   REAL zllm,z1llm
     33  REAL zllm
    3334
    3435  INTEGER l,ij,idum,ii
    … …  
    7879  DO l = 1,50
    7980     IF(lstardis) THEN
    80         CALL divgrad2(1,zh,deltap,niterh,zh)
     81        CALL divgrad2(1,zh,deltap,niterh,divgra)
    8182     ELSE
    82         CALL divgrad (1,zh,niterh,zh)
     83        CALL divgrad (1,zh,niterh,divgra)
    8384     ENDIF
    8485
    85      CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
    86 
    87      zllm  = ABS( zhmax )
    88      z1llm = 1./zllm
    89      DO ij = 1,ip1jmp1
    90         zh(ij) = zh(ij)* z1llm
    91      ENDDO
     86     zllm  = ABS(maxval(divgra))
     87     zh = divgra / zllm
    9288  ENDDO
    9389
    … …  
    123119           !cccc             CALL covcont( 1,zu,zv,zu,zv )
    124120           IF(lstardis) THEN
    125               CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
     121              CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy )
    126122           ELSE
    127               CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
     123              CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy )
    128124           ENDIF
    129125        ELSE
    130126           IF(lstardis) THEN
    131               CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
     127              CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy )
    132128           ELSE
    133               CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
     129              CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy )
    134130           ENDIF
    135131        ENDIF
    136132
    137         CALL minmax(iip1*jjp1,zu,umin,ullm )
    138         CALL minmax(iip1*jjm, zv,vmin,vllm )
    139 
    140         ullm = ABS  ( ullm )
    141         vllm = ABS  ( vllm )
    142 
    143         zllm  = MAX( ullm,vllm )
    144         z1llm = 1./ zllm
    145         DO ij = 1, ip1jmp1
    146            zu(ij) = zu(ij)* z1llm
    147         ENDDO
    148         DO ij = 1, ip1jm
    149            zv(ij) = zv(ij)* z1llm
    150         ENDDO
     133        zllm = max(abs(maxval(gx)), abs(maxval(gy)))
     134        zu = gx / zllm
     135        zv = gy / zllm
    151136     end DO
    152137

  • LMDZ5/branches/testing/libf/dyn3dpar/inigrads.F

    r774 r1665  
    99      implicit none
    1010
    11       integer if,im,jm,lm,i,j,l,lnblnk
     11      integer if,im,jm,lm,i,j,l
    1212      real x(im),y(jm),z(lm),fx,fy,fz,dt
    1313      real xmin,xmax,ymin,ymax
    … …  
    4040      ivar(if)=0
    4141
    42       fichier(if)=file(1:lnblnk(file))
     42      fichier(if)=trim(file)
    4343
    4444      firsttime(if)=.true.
    … …  
    7070
    7171      print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
    72       print*,file(1:lnblnk(file))//'.dat'
     72      print*,trim(file)//'.dat'
    7373
    74       OPEN (unit(if)+1,FILE=file(1:lnblnk(file))//'.dat'
     74      OPEN (unit(if)+1,FILE=trim(file)//'.dat'
    7575     s   ,FORM='unformatted',
    7676     s   ACCESS='direct'

  • LMDZ5/branches/testing/libf/dyn3dpar/integrd_p.F

    r1550 r1665  
    44      SUBROUTINE integrd_p
    55     $  (  nq,vcovm1,ucovm1,tetam1,psm1,massem1,
    6      $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
     6     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis) !,finvmaold)
    77      USE parallel
    88      USE control_mod, only : planet_type
    … …  
    3333#include "temps.h"
    3434#include "serre.h"
     35#include "iniprint.h"
    3536
    3637c   Arguments:
    3738c   ----------
    3839
    39       INTEGER nq
    40 
    41       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    42       REAL q(ip1jmp1,llm,nq)
    43       REAL ps0(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
    44 
    45       REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
    46       REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
    47 
    48       REAL dv(ip1jm,llm),du(ip1jmp1,llm)
    49       REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
    50       REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
     40      integer,intent(in) :: nq ! number of tracers to handle in this routine
     41      real,intent(inout) :: vcov(ip1jm,llm) ! covariant meridional wind
     42      real,intent(inout) :: ucov(ip1jmp1,llm) ! covariant zonal wind
     43      real,intent(inout) :: teta(ip1jmp1,llm) ! potential temperature
     44      real,intent(inout) :: q(ip1jmp1,llm,nq) ! advected tracers
     45      real,intent(inout) :: ps0(ip1jmp1) ! surface pressure
     46      real,intent(inout) :: masse(ip1jmp1,llm) ! atmospheric mass
     47      real,intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
     48      ! values at previous time step
     49      real,intent(inout) :: vcovm1(ip1jm,llm)
     50      real,intent(inout) :: ucovm1(ip1jmp1,llm)
     51      real,intent(inout) :: tetam1(ip1jmp1,llm)
     52      real,intent(inout) :: psm1(ip1jmp1)
     53      real,intent(inout) :: massem1(ip1jmp1,llm)
     54      ! the tendencies to add
     55      real,intent(in) :: dv(ip1jm,llm)
     56      real,intent(in) :: du(ip1jmp1,llm)
     57      real,intent(in) :: dteta(ip1jmp1,llm)
     58      real,intent(in) :: dp(ip1jmp1)
     59      real,intent(in) :: dq(ip1jmp1,llm,nq) !!! unused
     60!      real,intent(out) :: finvmaold(ip1jmp1,llm) !!! unused
    5161
    5262c   Local:
    … …  
    5464
    5565      REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
    56       REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
     66      REAL massescr( ip1jmp1,llm )
     67!      REAL finvmasse(ip1jmp1,llm)
    5768      REAL,SAVE :: p(ip1jmp1,llmp1)
    5869      REAL tpn,tps,tppn(iim),tpps(iim)
    … …  
    6071      REAL,SAVE :: deltap( ip1jmp1,llm )
    6172
    62       INTEGER  l,ij,iq
     73      INTEGER  l,ij,iq,i,j
    6374
    6475      REAL SSUM
    … …  
    126137       
    127138        IF( .NOT. checksum ) THEN
    128          PRINT*,' Au point ij = ',stop_it, ' , pression sol neg. '
    129      &         , ps(stop_it)
    130          print *, ' dans integrd'
    131          stop 1
     139         write(lunout,*) "integrd: negative surface pressure ",
     140     &                                                ps(stop_it)
     141         write(lunout,*) " at node ij =", stop_it
     142         ! since ij=j+(i-1)*jjp1 , we have
     143         j=modulo(stop_it,jjp1)
     144         i=1+(stop_it-j)/jjp1
     145         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
     146     &                   " lat = ",rlatu(j)*180./pi, " deg"
    132147        ENDIF
    133148
    … …  
    167182      CALL massdair_p (     p  , masse         )
    168183
    169 c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
    170       ijb=ij_begin
    171       ije=ij_end
    172      
    173 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    174       DO  l = 1,llm
    175         finvmasse(ijb:ije,l)=masse(ijb:ije,l)
    176       ENDDO
    177 c$OMP END DO NOWAIT
    178 
    179       jjb=jj_begin
    180       jje=jj_end
    181       CALL filtreg_p( finvmasse,jjb,jje, jjp1, llm, -2, 2, .TRUE., 1  )
     184! Ehouarn : we don't use/need finvmaold and finvmasse,
     185!           so might as well not compute them
     186!c      CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
     187!      ijb=ij_begin
     188!      ije=ij_end
     189!     
     190!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     191!      DO  l = 1,llm
     192!        finvmasse(ijb:ije,l)=masse(ijb:ije,l)
     193!      ENDDO
     194!c$OMP END DO NOWAIT
     195!
     196!      jjb=jj_begin
     197!      jje=jj_end
     198!      CALL filtreg_p( finvmasse,jjb,jje, jjp1, llm, -2, 2, .TRUE., 1  )
    182199c
    183200
    … …  
    330347      ENDIF
    331348     
    332 c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
    333 
    334 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    335       DO l = 1, llm     
    336         finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)       
    337       ENDDO
    338 c$OMP END DO NOWAIT
     349! Ehouarn: forget about finvmaold
     350!c         CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
     351!
     352!c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     353!      DO l = 1, llm     
     354!        finvmaold(ijb:ije,l)=finvmasse(ijb:ije,l)       
     355!      ENDDO
     356!c$OMP END DO NOWAIT
    339357
    340358      endif ! of if (planet_type.eq."earth")

  • LMDZ5/branches/testing/libf/dyn3dpar/leapfrog_p.F

    r1664 r1665  
    7575
    7676      real zqmin,zqmax
    77       INTEGER nbetatmoy, nbetatdem,nbetat
    7877
    7978c   variables dynamiques
    … …  
    125124      REAL  SSUM
    126125      REAL time_0
    127       REAL,SAVE :: finvmaold(ip1jmp1,llm)
     126!      REAL,SAVE :: finvmaold(ip1jmp1,llm)
    128127
    129128cym      LOGICAL  lafin
    … …  
    234233      dq(:,:,:)=0.
    235234      CALL pression ( ip1jmp1, ap, bp, ps, p       )
    236       if (disvert_type==1) then
     235      if (pressure_exner) then
    237236        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    238       else ! we assume that we are in the disvert_type==2 case
     237      else
    239238        CALL exner_milieu( ip1jmp1, ps, p, beta, pks, pk, pkf )
    240239      endif
    … …  
    245244c et du parallelisme !!
    246245
    247    1  CONTINUE
    248 
    249       jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec)
    250       jH_cur = jH_ref +                                                 &
    251      &          (itau * dtvr / daysec - int(itau * dtvr / daysec))
     246   1  CONTINUE ! Matsuno Forward step begins here
     247
     248      jD_cur = jD_ref + day_ini - day_ref +                             &
     249     &          itau/day_step
     250      jH_cur = jH_ref + start_time +                                    &
     251     &         mod(itau,day_step)/float(day_step)
     252      if (jH_cur > 1.0 ) then
     253        jD_cur = jD_cur +1.
     254        jH_cur = jH_cur -1.
     255      endif
    252256
    253257
    … …  
    280284         massem1= masse
    281285         psm1= ps
    282          
    283          finvmaold = masse
    284          CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
     286
     287! Ehouarn: finvmaold is actually not used       
     288!         finvmaold = masse
     289!         CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
    285290c$OMP END MASTER
    286291c$OMP BARRIER
    … …  
    300305           tetam1   (ijb:ije,l) = teta  (ijb:ije,l)
    301306           massem1  (ijb:ije,l) = masse (ijb:ije,l)
    302            finvmaold(ijb:ije,l)=masse(ijb:ije,l)
     307!           finvmaold(ijb:ije,l)=masse(ijb:ije,l)
    303308                 
    304309           if (pole_sud) ije=ij_end-iip1
    … …  
    309314c$OMP ENDDO 
    310315
    311 
    312           CALL filtreg_p ( finvmaold ,jj_begin,jj_end,jjp1,
    313      .                    llm, -2,2, .TRUE., 1 )
     316! Ehouarn: finvmaold not used
     317!          CALL filtreg_p ( finvmaold ,jj_begin,jj_end,jjp1,
     318!     .                    llm, -2,2, .TRUE., 1 )
    314319
    315320       endif ! of if (FirstCaldyn)
    … …  
    327332cym      call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
    328333
    329    2  CONTINUE
     334   2  CONTINUE ! Matsuno backward or leapfrog step begins here
    330335
    331336c$OMP MASTER
    … …  
    472477         call Register_SwapFieldHallo(phi,phi,ip1jmp1,llm,
    473478     &                                jj_Nb_caldyn,0,0,TestRequest)
    474          call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
    475      &                                jj_Nb_caldyn,0,0,TestRequest)
     479!         call Register_SwapFieldHallo(finvmaold,finvmaold,ip1jmp1,llm,
     480!     &                                jj_Nb_caldyn,0,0,TestRequest)
    476481 
    477482        do j=1,nqtot
    … …  
    555560      call start_timer(timer_caldyn)
    556561
     562      ! compute geopotential phi()
    557563      CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    558564
    … …  
    629635
    630636       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    631      $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    632      $              finvmaold                                    )
     637     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis )
     638!     $              finvmaold                                    )
    633639
    634640!       CALL FTRACE_REGION_END("integrd")
    … …  
    693699
    694700c$OMP BARRIER
    695          if (disvert_type==1) then
     701         if (pressure_exner) then
    696702           CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    697          else ! we assume that we are in the disvert_type==2 case
     703         else
    698704           CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
    699705         endif
    700706c$OMP BARRIER
    701707           jD_cur = jD_ref + day_ini - day_ref
    702      $        + int (itau * dtvr / daysec)
    703            jH_cur = jH_ref +                                            &
    704      &              (itau * dtvr / daysec - int(itau * dtvr / daysec))
     708     $        + itau/day_step
     709           jH_cur = jH_ref + start_time +                                &
     710     &              mod(itau,day_step)/float(day_step)
    705711!         call ju2ymds(jD_cur+jH_cur, an, mois, jour, secondes)
     712           if (jH_cur > 1.0 ) then
     713             jD_cur = jD_cur +1.
     714             jH_cur = jH_cur -1.
     715           endif
    706716
    707717c rajout debug
    … …  
    719729! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
    720730           IF (planet_type.eq."earth") THEN
     731#ifdef CPP_EARTH
    721732            CALL diagedyn(ztit,2,1,1,dtphys
    722733     &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     734#endif
    723735           ENDIF
    724736      ENDIF
    … …  
    10361048        CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
    10371049c$OMP BARRIER
    1038         if (disvert_type==1) then
     1050        if (pressure_exner) then
    10391051          CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    1040         else ! we assume that we are in the disvert_type==2 case
     1052        else
    10411053          CALL exner_milieu_p( ip1jmp1, ps, p, beta, pks, pk, pkf )
    10421054        endif
    … …  
    11851197c$OMP END DO NOWAIT
    11861198
     1199         if (1 == 0) then
     1200!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
     1201!!!                     2) should probably not be here anyway
     1202!!! but are kept for those who would want to revert to previous behaviour
    11871203c$OMP MASTER               
    11881204          DO ij =  1,iim
    … …  
    11951211          ENDDO
    11961212c$OMP END MASTER
    1197         endif
     1213         endif ! of if (1 == 0)
     1214        endif ! of of (pole_nord)
    11981215       
    11991216        if (pole_sud) then
    … …  
    12111228c$OMP END DO NOWAIT
    12121229
     1230         if (1 == 0) then
     1231!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
     1232!!!                     2) should probably not be here anyway
     1233!!! but are kept for those who would want to revert to previous behaviour
    12131234c$OMP MASTER               
    12141235          DO ij =  1,iim
    … …  
    12211242          ENDDO
    12221243c$OMP END MASTER
    1223         endif
     1244         endif ! of if (1 == 0)
     1245        endif ! of if (pole_sud)
    12241246
    12251247
    … …  
    14311453c$OMP BARRIER
    14321454c$OMP MASTER
    1433               nbetat = nbetatdem
    14341455              CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    14351456       
    … …  
    16341655c$OMP BARRIER
    16351656c$OMP MASTER
    1636                 nbetat = nbetatdem
    16371657                CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    16381658

  • LMDZ5/branches/testing/libf/dyn3dpar/mod_interface_dyn_phys.F90

    r1279 r1665  
    77 
    88 
    9 #ifdef CPP_EARTH
     9#ifdef CPP_PHYS
    1010! Interface with parallel physics,
    11 ! for now this routine only works with Earth physics
    1211CONTAINS
    1312 
    … …  
    5655  END SUBROUTINE Init_interface_dyn_phys
    5756#endif
    58 ! of #ifdef CPP_EARTH
     57! of #ifdef CPP_PHYS
    5958END MODULE mod_interface_dyn_phys

  • LMDZ5/branches/testing/libf/dyn3dpar/temps.h

    r1279 r1665  
    1414
    1515      COMMON/temps/itaufin, dt, day_ini, day_end, annee_ref, day_ref,   &
    16      &             itau_dyn, itau_phy, jD_ref, jH_ref, calend
     16     &             itau_dyn, itau_phy, jD_ref, jH_ref, calend,          &
     17     &             start_time
     18
    1719
    1820      INTEGER   itaufin
    1921      INTEGER itau_dyn, itau_phy
    2022      INTEGER day_ini, day_end, annee_ref, day_ref
    21       REAL      dt, jD_ref, jH_ref
     23      REAL      dt, jD_ref, jH_ref, start_time
    2224      CHARACTER (len=10) :: calend
    2325

  • LMDZ5/branches/testing/libf/dyn3dpar/wrgrads.F

    r774 r1665  
    2222c   local
    2323
    24       integer im,jm,lm,i,j,l,lnblnk,iv,iii,iji,iif,ijf
     24      integer im,jm,lm,i,j,l,iv,iii,iji,iif,ijf
    2525
    2626      logical writectl
    … …  
    5555            nvar(if)=ivar(if)
    5656            var(ivar(if),if)=name
    57             tvar(ivar(if),if)=titlevar(1:lnblnk(titlevar))
     57            tvar(ivar(if),if)=trim(titlevar)
    5858            nld(ivar(if),if)=nl
    5959            print*,'initialisation ecriture de ',var(ivar(if),if)
    … …  
    9696      file=fichier(if)
    9797c   WARNING! on reecrase le fichier .ctl a chaque ecriture
    98       open(unit(if),file=file(1:lnblnk(file))//'.ctl'
     98      open(unit(if),file=trim(file)//'.ctl'
    9999     &         ,form='formatted',status='unknown')
    100100      write(unit(if),'(a5,1x,a40)')
    101      &       'DSET ','^'//file(1:lnblnk(file))//'.dat'
     101     &       'DSET ','^'//trim(file)//'.dat'
    102102
    103103      write(unit(if),'(a12)') 'UNDEF 1.0E30'
Note: See TracChangeset for help on using the changeset viewer.