Ignore:
Timestamp:
Jul 21, 2000, 10:28:19 AM (24 years ago)
Author:
lmdzadmin
Message:

Rajout interface ocean couple

Location:
LMDZ.3.3/branches/rel-LF/libf/phylmd
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F

    r102 r105  
    102102      REAL sollw(klon), solsw(klon)
    103103      REAL rugos(klon,nbsrf)
     104C la nouvelle repartition des surfaces sortie de l'interface
     105      REAL pctsrf_new(klon,nbsrf)
    104106cAA
    105107      REAL zcoefh(klon,klev)
    … …  
    152154cAA   INTEGER it
    153155      INTEGER ni(klon), knon, j
     156c Introduction d'une variable "pourcentage potentiel" pour tenir compte
     157c des eventuelles apparitions et/ou disparitions de la glace de mer
     158      REAL pctsrf_pot(klon,nbsrf)
     159     
    154160c======================================================================
    155161      REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
    … …  
    215221c Boucler sur toutes les sous-fractions du sol:
    216222c
     223C Initialisation des "pourcentages potentiels". On considere ici qu'on
     224C peut avoir potentiellementdela glace sur tout le domaine oceanique
     225C (a affiner)
     226
     227      pctsrf_pot = pctsrf
     228      pctsrf_pot(:,is_sic) = pctsrf(:,is_oce)
     229
    217230      DO 99999 nsrf = 1, nbsrf
    218231c
    … …  
    243256      knon = 0
    244257      DO i = 1, klon
    245       IF (pctsrf(i,nsrf).GT.epsfra) THEN
     258
     259C pour determiner le domaine a traiter on utilise les surfaces "potentielles"
     260C 
     261      IF (pctsrf_pot(i,nsrf).GT.epsfra) THEN
    246262         knon = knon + 1
    247263         ni(knon) = i
    … …  
    302318c
    303319c
     320c calculer la diffusion des vitesses "u" et "v"
     321      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
     322     s            y_d_u,y_flux_u)
     323      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
     324     s            y_d_v,y_flux_v)
     325
     326c pour le couplage
     327      ytaux = y_flux_u(:,1)
     328      ytauy = y_flux_v(:,1)
    304329c calculer la diffusion de "q" et de "h"
    305330      CALL clqh(knon, dtime, nsrf, ni, pctsrf, rlon, rlat,
    … …  
    307332     e          ycoefh,yt,yq,yts,ypaprs,ypplay,ydelp,yrads,
    308333     e          yevap,yalb, ysnow, yqsol, yrain_f, ysnow_f,
    309      e          yfder, ytaux, ytauy,
    310      e          ysollw, ysolsw,
     334     e          yfder, ytaux, ytauy, ysollw, ysolsw,
     335     s          pctsrf_new,
    311336     s          y_d_t, y_d_q, y_d_ts,
    312337     s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q)
    313 c
    314 c calculer la diffusion des vitesses "u" et "v"
    315       CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
    316      s            y_d_u,y_flux_u)
    317       CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
    318      s            y_d_v,y_flux_v)
    319338c
    320339c calculer la longueur de rugosite sur ocean
    … …  
    430449     e                delp,radsol,evap,albedo,snow,qsol,
    431450     e                precip_rain, precip_snow, fder, taux, tauy,
    432      e                lwdown, swdown,
     451     e                lwdown, swdown,
     452     s                pctsrf_new,
    433453     s                d_t, d_q, d_ts, flux_t, flux_q,dflux_s,dflux_l)
    434454
    … …  
    669689      petBcoef=zx_dh(:,1)
    670690      peqBcoef=zx_dq(:,1)
    671       coef1lay=coef(:,1)
     691      tq_cdrag=coef(:,1)
    672692      temp_air=t(:,1)
    673693      spechum=q(:,1)
    … …  
    678698      hum_air = 0.
    679699      ccanopy = 0.
    680       tq_cdrag = 0.
    681700
    682701      CALL interfsurf(itime, dtime, jour,
    … …  
    688707     . fder, taux, tauy,
    689708     . albedo, snow, qsol,
    690      . ts, p1lay, coef1lay, psref, radsol,
    691      . ocean,
     709     . ts, p1lay, psref, radsol,
     710     . ocean,zmasq
    692711     . evap, fluxsens, fluxlat, dflux_l, dflux_s,             
    693      . tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new,
    694      . zmasq)
     712     . tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
    695713
    696714      flux_t(:,1) = fluxsens

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90

    r101 r105  
    3838! run_off      ruissellement total
    3939  real, allocatable, dimension(:),save    :: run_off
     40#include "YOMCST.inc"
    4041
    4142
    … …  
    5253      & fder, taux, tauy, &
    5354      & albedo, snow, qsol, &
    54       & tsurf, p1lay, coef1lay, ps, radsol, &
    55       & ocean, &
     55      & tsurf, p1lay, ps, radsol, &
     56      & ocean, zmasq, &
    5657      & evap, fluxsens, fluxlat, dflux_l, dflux_s, &             
    57       & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new, zmasq)
     58      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
    5859
    5960
    … …  
    103104!   tsurf        temperature de surface
    104105!   p1lay        pression 1er niveau (milieu de couche)
    105 !   coef1lay     coefficient d'echange
    106106!   ps           pression au sol
    107107!   radsol       rayonnement net aus sol (LW + SW)
    … …  
    109109!   fder         derivee des flux (pour le couplage)
    110110!   taux, tauy   tension de vents
     111!   zmasq        masque terre/ocean
    111112!
    112113! output:
    … …  
    120121!   z0_new       surface roughness
    121122!   pctsrf_new   nouvelle repartition des surfaces
    122 !   zmasq        masque terre/ocean
    123123
    124124  include 'indicesol.h'
    … …  
    144144  real, dimension(knon), intent(IN) :: precip_rain, precip_snow
    145145  real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps, albedo
    146   real, dimension(knon), intent(IN) :: tsurf, p1lay, coef1lay
     146  real, dimension(knon), intent(IN) :: tsurf, p1lay
    147147  real, dimension(knon), intent(IN) :: radsol
    148148  real, dimension(klon), intent(IN) :: zmasq
    … …  
    169169  integer              :: nexca !pas de temps couplage
    170170  real, dimension(knon):: alb_ice
     171  real, dimension(knon):: tsurf_temp
    171172
    172173#include "YOMCST.inc"
    … …  
    191192      call abort_gcm(modname,abort_message,1)
    192193    endif
     194    if ( is_oce > is_sic ) then
     195      write(*,*)' *** Warning ***'
     196      write(*,*)' Pour des raisons de sequencement dans le code'
     197      write(*,*)' l''ocean doit etre traite avant la banquise'
     198      write(*,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic
     199      abort_message='voir ci-dessus'
     200      call abort_gcm(modname,abort_message,1)
    193201  endif
    194202  first_call = .false.
    … …  
    228236      cal = RCPD * capsol
    229237      call calcul_fluxs( knon, nisurf, dtime, &
    230      &   tsurf, p1lay, cal, beta, coef1lay, ps, &
     238     &   tsurf, p1lay, cal, beta, tq_cdrag, ps, &
    231239     &   precip_rain, precip_snow, snow, qsol,  &
    232240     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    … …  
    247255     &  tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    248256     &  precip_rain, precip_snow, lwdown, swnet, swdown, &
    249      &  tsurf, p1lay, coef1lay, ps, radsol, &
     257     &  tsurf, p1lay, ps, radsol, &
    250258     &  evap, fluxsens, fluxlat, &             
    251259     &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
    … …  
    271279      & ocean, nexca, debut, lafin, &
    272280      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    273       & fder, albedo, taux, tauy, &
     281      & fder, albedo, taux, tauy, zmasq, &
    274282      & tsurf_new, alb_new, alb_ice, pctsrf_new)
     283
     284      tsurf_temp = tsurf_new
    275285
    276286!    else if (ocean == 'slab  ') then
    … …  
    281291!     &  debut, &
    282292!     &  tsurf_new, alb_new, z0_new, pctsrf_new)
     293!
    283294    endif
    284 !
     295
    285296    cal = 0.
    286297    beta = 1.
    287298    dif_grnd = 0.
    288299
     300    endif
    289301    call calcul_fluxs( knon, nisurf, dtime, &
    290      &   tsurf, p1lay, cal, beta, coef1lay, ps, &
     302     &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
    291303     &   precip_rain, precip_snow, snow, qsol,  &
    292304     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    … …  
    307319! Surface "glace de mer" appel a l'interface avec l'ocean
    308320!
    309 !    call interfoce(nisurf, ocean)
    310 !
    311 
    312     cal = calice
    313     where (snow > 0.0) cal = calsno
    314     beta = 1.0
    315     dif_grnd = 1.0 / tau_gl
     321!
     322    if (ocean == 'couple') then
     323      nexca = 0
     324
     325      call interfoce(itime, dtime, &
     326      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
     327      & ocean, nexca, debut, lafin, &
     328      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
     329      & fder, albedo, taux, tauy, zmasq, &
     330      & tsurf_new, alb_new, alb_ice, pctsrf_new)
     331
     332      tsurf_temp = tsurf_new
     333      cal = 0.
     334      dif_grnd = 0.
     335
     336!    else if (ocean == 'slab  ') then
     337!      call interfoce(nisurf)
     338    else                              ! lecture conditions limites
     339!      call interfoce(itime, dtime, jour, &
     340!     &  klon, nisurf, knon, knindex, &
     341!     &  debut, &
     342!     &  tsurf_new, alb_new, z0_new, pctsrf_new)endif
     343
     344      cal = calice
     345      where (snow > 0.0) cal = calsno
     346      beta = 1.0
     347      dif_grnd = 1.0 / tau_gl
     348      tsurf_temp = tsurf
     349    endif
    316350
    317351    call calcul_fluxs( knon, nisurf, dtime, &
    318      &   tsurf, p1lay, cal, beta, coef1lay, ps, &
     352     &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
    319353     &   precip_rain, precip_snow, snow, qsol,  &
    320354     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    … …  
    338372
    339373    call calcul_fluxs( knon, nisurf, dtime, &
    340      &   tsurf, p1lay, cal, beta, coef1lay, ps, &
     374     &   tsurf, p1lay, cal, beta, tq_cdrag, ps, &
    341375     &   precip_rain, precip_snow, snow, qsol,  &
    342376     &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
    … …  
    386420     & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    387421     & precip_rain, precip_snow, lwdown, swnet, swdown, &
    388      & tsurf, p1lay, coef1lay, ps, radsol, &
     422     & tsurf, p1lay, ps, radsol, &
    389423     & evap, fluxsens, fluxlat, &             
    390424     & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
    … …  
    427461!   tsurf        temperature de surface
    428462!   p1lay        pression 1er niveau (milieu de couche)
    429 !   coef1lay     coefficient d'echange
    430463!   ps           pression au sol
    431464!   radsol       rayonnement net aus sol (LW + SW)
    … …  
    463496  real, dimension(knon), intent(IN) :: precip_rain, precip_snow
    464497  real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps
    465   real, dimension(knon), intent(IN) :: tsurf, p1lay, coef1lay
     498  real, dimension(knon), intent(IN) :: tsurf, p1lay
    466499  real, dimension(knon), intent(IN) :: radsol
    467500! Parametres de sortie
    … …  
    569602      & ocean, nexca, debut, lafin, &
    570603      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    571       & fder, albsol, taux, tauy, &
     604      & fder, albsol, taux, tauy, zmasq, &
    572605      & tsurf_new, alb_new, alb_ice, pctsrf_new)
    573 
    574 
    575606
    576607! Cette routine sert d'interface entre le modele atmospherique et un
    577608! coupleur avec un modele d'ocean 'complet' derriere
     609!
     610! Le modele de glace qu'il est prevu d'utiliser etant couple directement a
     611! l'ocean presentement, on va passer deux fois dans cette routine par pas de
     612! temps physique, une fois avec les points oceans et l'autre avec les points
     613! glace. A chaque pas de temps de couplage, la lecture des champs provenant
     614! du coupleur se fera "dans" l'ocean et l'ecriture des champs a envoyer
     615! au coupleur "dans" la glace. Il faut donc des tableaux de travail "tampons"
     616! dimensionnes sur toute la grille qui remplissent les champs sur les
     617! domaines ocean/glace quand il le faut. Il est aussi necessaire que l'index
     618! ocean soit traiter avant l'index glace (sinon tout intervertir)
     619!
    578620!
    579621! L. Fairhead 02/2000
    … …  
    605647!   tauy         tension de vent en y
    606648!   nexca        frequence de couplage
     649!   zmasq        masque terre/ocean
    607650!
    608651!
    … …  
    632675  real, dimension(knon), intent(IN) :: tsurf, fder, albsol, taux, tauy
    633676  integer              :: nexca
     677  real, dimension(klon), intent(IN) :: zmasq
    634678
    635679  real, dimension(knon), intent(INOUT) :: evap
    … …  
    646690  logical              :: check = .true.
    647691! variables pour moyenner les variables de couplage
    648   real, allocatable, dimension(:),save :: cpl_sols, cpl_nsol, cpl_rain
    649   real, allocatable, dimension(:),save :: cpl_snow, cpl_evap, cpl_tsol
    650   real, allocatable, dimension(:),save :: cpl_fder, cpl_albe, cpl_taux
    651   real, allocatable, dimension(:),save :: cpl_tauy, cpl_ruis
     692  real, allocatable, dimension(:,:),save :: cpl_sols, cpl_nsol, cpl_rain
     693  real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol
     694  real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux
     695  real, allocatable, dimension(:,:),save :: cpl_tauy, cpl_rriv, cpl_rcoa
     696! variables tampons avant le passage au coupleur
     697  real, allocatable, dimension(:,:,:),save :: tmp_sols, tmp_nsol, tmp_rain
     698  real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol
     699  real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux
     700  real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa
    652701! variables a passer au coupleur
    653   real, dimension(iim, jjm+1) :: wri_sols, wri_nsol, wri_rain
    654   real, dimension(iim, jjm+1) :: wri_snow, wri_evap, wri_tsol
    655   real, dimension(iim, jjm+1) :: wri_fder, wri_albe, wri_taux
    656   real, dimension(iim, jjm+1) :: wri_tauy, wri_ruis
     702  real, dimension(iim, jjm+1) :: wri_sol_ice, wri_sol_sea, wri_nsol_ice
     703  real, dimension(iim, jjm+1) :: wri_nsol_sea, wri_fder_ice, wri_evap_ice
     704  real, dimension(iim, jjm+1) :: wri_evap_sea
     705  real, dimension(iim, jjm+1) :: wri_rain, wri_snow, wri_taux
     706  real, dimension(iim, jjm+1) :: wri_tauy, wri_rriv, wri_rcoa
    657707! variables relues par le coupleur
    658   real, dimension(iim, jjm+1) :: read_sst, read_sic
    659   real, dimension(iim, jjm+1) :: read_alb_sst, read_alb_sic
     708! read_sic = fraction de glace
     709! read_sit = temperature de glace
     710  real, allocatable, dimension(:,:),save :: read_sst, read_sic, read_sit
     711  real, allocatable, dimension(:,:),save :: read_alb_sic
    660712! variable tampon
    661713  real, dimension(klon)       :: tamp
    662714  real, dimension(knon)       :: tamp_sic
    663 
    664 
     715  real, dimension(iim, jjm+1, 2) :: tamp_srf
     716  integer, allocatable, dimension(:), save :: tamp_ind
     717  real, allocatable, dimension(:,:),save :: tamp_zmasq
     718  real, dimension(iim, jjm+1) :: deno
    665719!
    666720! Initialisation
    … …  
    668722  if (debut) then
    669723    sum_error = 0
    670     allocate(cpl_sols(knon), stat = error)
    671     sum_error = sum_error + error
    672     allocate(cpl_nsol(knon), stat = error)
    673     sum_error = sum_error + error
    674     allocate(cpl_rain(knon), stat = error)
    675     sum_error = sum_error + error
    676     allocate(cpl_snow(knon), stat = error)
    677     sum_error = sum_error + error
    678     allocate(cpl_evap(knon), stat = error)
    679     sum_error = sum_error + error
    680     allocate(cpl_tsol(knon), stat = error)
    681     sum_error = sum_error + error
    682     allocate(cpl_fder(knon), stat = error)
    683     sum_error = sum_error + error
    684     allocate(cpl_albe(knon), stat = error)
    685     sum_error = sum_error + error
    686     allocate(cpl_taux(knon), stat = error)
    687     sum_error = sum_error + error
    688     allocate(cpl_tauy(knon), stat = error)
    689     sum_error = sum_error + error
    690     allocate(cpl_ruis(knon), stat = error)
    691     sum_error = sum_error + error
     724    allocate(cpl_sols(knon,2), stat = error); sum_error = sum_error + error
     725    allocate(cpl_nsol(knon,2), stat = error); sum_error = sum_error + error
     726    allocate(cpl_rain(knon,2), stat = error); sum_error = sum_error + error
     727    allocate(cpl_snow(knon,2), stat = error); sum_error = sum_error + error
     728    allocate(cpl_evap(knon,2), stat = error); sum_error = sum_error + error
     729    allocate(cpl_tsol(knon,2), stat = error); sum_error = sum_error + error
     730    allocate(cpl_fder(knon,2), stat = error); sum_error = sum_error + error
     731    allocate(cpl_albe(knon,2), stat = error); sum_error = sum_error + error
     732    allocate(cpl_taux(knon,2), stat = error); sum_error = sum_error + error
     733    allocate(cpl_tauy(knon,2), stat = error); sum_error = sum_error + error
     734    allocate(cpl_rcoa(knon,2), stat = error); sum_error = sum_error + error
     735    allocate(cpl_rriv(knon,2), stat = error); sum_error = sum_error + error
     736    allocate(read_sst(iim, jjm+1), stat = error); sum_error = sum_error + error
     737    allocate(read_sic(iim, jjm+1), stat = error); sum_error = sum_error + error
     738    allocate(read_sit(iim, jjm+1), stat = error); sum_error = sum_error + error
     739    allocate(read_sit(iim, jjm+1), stat = error); sum_error = sum_error + error
     740    allocate(read_alb_sic(iim, jjm+1), stat = error); sum_error = sum_error + error
     741
    692742    if (sum_error /= 0) then
    693743      abort_message='Pb allocation variables couplees'
    694744      call abort_gcm(modname,abort_message,1)
    695745    endif
    696     cpl_sols = 0.
    697     cpl_nsol = 0.
    698     cpl_rain = 0.
    699     cpl_snow = 0.
    700     cpl_evap = 0.
    701     cpl_tsol = 0.
    702     cpl_fder = 0.
    703     cpl_albe = 0.
    704     cpl_taux = 0.
    705     cpl_tauy = 0.
    706     cpl_ruis = 0.
     746    cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
     747    cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
     748    cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.
     749
     750    sum_error = 0
     751    allocate(tamp_ind(klon), stat = error); sum_error = sum_error + error
     752    allocate(tamp_zmasq(iim, jjm+1), stat = error); sum_error = sum_error + error   
     753    do ig = 1, klon
     754      tamp_ind(ig) = ig
     755    enddo
     756    call gath2cpl(zmasq, tamp_zmasq, klon, klon, iim, jjm, tamp_ind)
    707757!
    708758! initialisation couplage
    … …  
    712762! 1ere lecture champs ocean
    713763!
    714     call fromcpl(itime,(jjm+1)*iim,                                          &
    715      &        read_sst, read_sic, read_alb_sst, read_alb_sic)
     764    if (nisurf == is_oce) then
     765      call fromcpl(itime,(jjm+1)*iim,                                  &
     766     &        read_sst, read_sic, read_sit, read_alb_sic)
     767!
     768! je voulais utiliser des where mais ca ne voulait pas compiler dans un
     769! if construct sur sun
     770!
     771      do j = 1, jjm + 1
     772        do ig = 1, iim
     773          if (abs(1. - read_sic(ig,j)) < 0.00001) then
     774            read_sst(ig,j) = RTT - 1.8
     775            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
     776            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
     777          else if (abs(read_sic(ig,j)) < 0.00001) then
     778            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
     779            read_sit(ig,j) = read_sst(ig,j)
     780            read_alb_sic(ig,j) =  0.6
     781          else
     782            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
     783            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
     784            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
     785          endif
     786        enddo
     787      enddo
     788    endif
     789
     790  endif ! fin if (debut)
     791
     792! fichier restart et fichiers histoires
     793
     794! calcul des fluxs a passer
     795
     796  cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown      / FLOAT(nexca)
     797  cpl_nsol(:,nisurf) = cpl_nsol(:,nisurf) + lwdown      / FLOAT(nexca)
     798  cpl_rain(:,nisurf) = cpl_rain(:,nisurf) + precip_rain / FLOAT(nexca)
     799  cpl_snow(:,nisurf) = cpl_snow(:,nisurf) + precip_snow / FLOAT(nexca)
     800  cpl_evap(:,nisurf) = cpl_evap(:,nisurf) + evap        / FLOAT(nexca)
     801  cpl_tsol(:,nisurf) = cpl_tsol(:,nisurf) + tsurf       / FLOAT(nexca)
     802  cpl_fder(:,nisurf) = cpl_fder(:,nisurf) + fder        / FLOAT(nexca)
     803  cpl_albe(:,nisurf) = cpl_albe(:,nisurf) + albsol      / FLOAT(nexca)
     804  cpl_taux(:,nisurf) = cpl_taux(:,nisurf) + taux        / FLOAT(nexca)
     805  cpl_tauy(:,nisurf) = cpl_tauy(:,nisurf) + tauy        / FLOAT(nexca)
     806  cpl_rriv(:,nisurf) = cpl_rriv(:,nisurf) + run_off     / FLOAT(nexca)/dtime
     807  cpl_rcoa(:,nisurf) = cpl_rcoa(:,nisurf) + run_off     / FLOAT(nexca)/dtime
     808
     809  if (mod(itime, nexca) == 0) then
     810!
     811! Mise sur la bonne grille des champs a passer au coupleur
     812!
     813! allocation memoire
     814    sum_error = 0
     815    allocate(tmp_sols(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     816    allocate(tmp_nsol(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     817    allocate(tmp_rain(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     818    allocate(tmp_snow(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     819    allocate(tmp_evap(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     820    allocate(tmp_tsol(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     821    allocate(tmp_fder(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     822    allocate(tmp_albe(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     823    allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     824    allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     825    allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     826    allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     827    if (sum_error /= 0) then
     828      abort_message='Pb allocation variables couplees'
     829      call abort_gcm(modname,abort_message,1)
     830    endif
     831
     832    call gath2cpl(cpl_sols(1,nisurf), tmp_sols(1,1,nisurf), klon, knon,iim,jjm, knindex)
     833    call gath2cpl(cpl_nsol(1,nisurf), tmp_nsol(1,1,nisurf), klon, knon,iim,jjm, knindex)
     834    call gath2cpl(cpl_rain(1,nisurf), tmp_rain(1,1,nisurf), klon, knon,iim,jjm, knindex)
     835    call gath2cpl(cpl_snow(1,nisurf), tmp_snow(1,1,nisurf), klon, knon,iim,jjm, knindex)
     836    call gath2cpl(cpl_evap(1,nisurf), tmp_evap(1,1,nisurf), klon, knon,iim,jjm, knindex)
     837    call gath2cpl(cpl_tsol(1,nisurf), tmp_tsol(1,1,nisurf), klon, knon,iim,jjm, knindex)
     838    call gath2cpl(cpl_fder(1,nisurf), tmp_fder(1,1,nisurf), klon, knon,iim,jjm, knindex)
     839    call gath2cpl(cpl_albe(1,nisurf), tmp_albe(1,1,nisurf), klon, knon,iim,jjm, knindex)
     840    call gath2cpl(cpl_taux(1,nisurf), tmp_taux(1,1,nisurf), klon, knon,iim,jjm, knindex)
     841    call gath2cpl(cpl_tauy(1,nisurf), tmp_tauy(1,1,nisurf), klon, knon,iim,jjm, knindex)
     842    call gath2cpl(cpl_rriv(1,nisurf), tmp_rriv(1,1,nisurf), klon, knon,iim,jjm, knindex)
     843    call gath2cpl(cpl_rcoa(1,nisurf), tmp_rcoa(1,1,nisurf), klon, knon,iim,jjm, knindex)
     844!
     845! Passage des champs au/du coupleur
     846!
     847! Si le domaine considere est l'ocean, on lit les champs venant du coupleur
     848!
     849    if (nisurf == is_oce) then
     850      call fromcpl(itime,(jjm+1)*iim,                                  &
     851     &        read_sst, read_sic, read_sit, read_alb_sic)
     852      do j = 1, jjm + 1
     853        do ig = 1, iim
     854          if (abs(1. - read_sic(ig,j)) < 0.00001) then
     855            read_sst(ig,j) = RTT - 1.8
     856            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
     857            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
     858          else if (abs(read_sic(ig,j)) < 0.00001) then
     859            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
     860            read_sit(ig,j) = read_sst(ig,j)
     861            read_alb_sic(ig,j) =  0.6
     862          else
     863            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
     864            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
     865            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
     866          endif
     867        enddo
     868      enddo
     869    endif
     870!
     871! Si le domaine considere est la banquise, on envoie les champs au coupleur
     872!
     873    if (nisurf == is_sic) then
     874      wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0.
     875      wri_taux = 0.; wri_tauy = 0.
     876      call gath2cpl(pctsrf(1,is_oce), tamp_srf(1,1,1), klon, klon, iim, jjm, tamp_ind)
     877      call gath2cpl(pctsrf(1,is_sic), tamp_srf(1,1,2), klon, klon, iim, jjm, tamp_ind)
     878
     879      wri_sol_ice = tmp_sols(:,:,2)
     880      wri_sol_sea = tmp_sols(:,:,1)
     881      wri_nsol_ice = tmp_nsol(:,:,2)
     882      wri_nsol_sea = tmp_nsol(:,:,1)
     883      wri_fder_ice = tmp_fder(:,:,2)
     884      wri_evap_ice = tmp_evap(:,:,2)
     885      wri_evap_sea = tmp_evap(:,:,1)
     886      where (tamp_zmasq /= 1.)
     887        deno =  tamp_srf(:,:,1) + tamp_srf(:,:,2)
     888        wri_rain = tmp_rain(:,:,1) * tamp_srf(:,:,1) / deno +    &
     889      &            tmp_rain(:,:,2) * tamp_srf(:,:,2) / deno
     890        wri_snow = tmp_snow(:,:,1) * tamp_srf(:,:,1) / deno +    &
     891      &            tmp_snow(:,:,2) * tamp_srf(:,:,2) / deno
     892        wri_rriv = tmp_rriv(:,:,1) * tamp_srf(:,:,1) / deno +    &
     893      &            tmp_rriv(:,:,2) * tamp_srf(:,:,2) / deno
     894        wri_rcoa = tmp_rcoa(:,:,1) * tamp_srf(:,:,1) / deno +    &
     895      &            tmp_rcoa(:,:,2) * tamp_srf(:,:,2) / deno
     896        wri_taux = tmp_taux(:,:,1) * tamp_srf(:,:,1) / deno +    &
     897      &            tmp_taux(:,:,2) * tamp_srf(:,:,2) / deno
     898        wri_tauy = tmp_tauy(:,:,1) * tamp_srf(:,:,1) / deno +    &
     899      &            tmp_tauy(:,:,2) * tamp_srf(:,:,2) / deno
     900      endwhere
     901
     902      call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
     903      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
     904      & wri_snow, wri_rcoa, wri_rriv, wri_taux, wri_tauy, wri_taux, wri_tauy, &
     905      & lafin )
     906      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
     907      cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
     908      cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.
     909!
     910! deallocation memoire variables temporaires
     911!
     912      sum_error = 0
     913      deallocate(tmp_sols, stat=error); sum_error = sum_error + error
     914      deallocate(tmp_nsol, stat=error); sum_error = sum_error + error
     915      deallocate(tmp_rain, stat=error); sum_error = sum_error + error
     916      deallocate(tmp_snow, stat=error); sum_error = sum_error + error
     917      deallocate(tmp_evap, stat=error); sum_error = sum_error + error
     918      deallocate(tmp_fder, stat=error); sum_error = sum_error + error
     919      deallocate(tmp_tsol, stat=error); sum_error = sum_error + error
     920      deallocate(tmp_albe, stat=error); sum_error = sum_error + error
     921      deallocate(tmp_taux, stat=error); sum_error = sum_error + error
     922      deallocate(tmp_tauy, stat=error); sum_error = sum_error + error
     923      deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
     924      deallocate(tmp_rcoa, stat=error); sum_error = sum_error + error
     925      if (sum_error /= 0) then
     926        abort_message='Pb deallocation variables couplees'
     927        call abort_gcm(modname,abort_message,1)
     928      endif
     929
     930    endif
     931
     932  endif            ! fin nexca
     933!
     934! on range les variables lues/sauvegardees dans les bonnes variables de sortie
     935!
     936  if (nisurf == is_oce) then
    716937    call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex)
    717938    call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex)
    718     call cpl2gath(read_alb_sst, alb_new, klon, knon,iim,jjm, knindex)
    719     call cpl2gath(read_alb_sic, alb_ice, klon, knon,iim,jjm, knindex)
    720939!
    721940! transformer tamp_sic en pctsrf_new
    … …  
    729948      endif
    730949    enddo
    731 
    732   endif ! fin if (debut)
    733 
    734 ! fichier restart et fichiers histoires
    735 
    736 ! calcul des fluxs a passer
    737 
    738   cpl_sols = cpl_sols + swdown      / FLOAT(nexca)
    739   cpl_nsol = cpl_nsol + lwdown      / FLOAT(nexca)
    740   cpl_rain = cpl_rain + precip_rain / FLOAT(nexca)
    741   cpl_snow = cpl_snow + precip_snow / FLOAT(nexca)
    742   cpl_evap = cpl_evap + evap        / FLOAT(nexca)
    743   cpl_tsol = cpl_tsol + tsurf       / FLOAT(nexca)
    744   cpl_fder = cpl_fder + fder        / FLOAT(nexca)
    745   cpl_albe = cpl_albe + albsol      / FLOAT(nexca)
    746   cpl_taux = cpl_taux + taux        / FLOAT(nexca)
    747   cpl_tauy = cpl_tauy + tauy        / FLOAT(nexca)
    748   cpl_ruis = cpl_ruis + run_off     / FLOAT(nexca)/dtime
    749 
    750   if (mod(itime, nexca) == 0) then
    751 !
    752 ! Mise sur la bonne grille des champs a passer au coupleur
    753     call gath2cpl(cpl_sols, wri_sols, klon, knon,iim,jjm, knindex)
    754     call gath2cpl(cpl_nsol, wri_nsol, klon, knon,iim,jjm, knindex)
    755     call gath2cpl(cpl_rain, wri_rain, klon, knon,iim,jjm, knindex)
    756     call gath2cpl(cpl_snow, wri_snow, klon, knon,iim,jjm, knindex)
    757     call gath2cpl(cpl_evap, wri_evap, klon, knon,iim,jjm, knindex)
    758     call gath2cpl(cpl_tsol, wri_tsol, klon, knon,iim,jjm, knindex)
    759     call gath2cpl(cpl_fder, wri_fder, klon, knon,iim,jjm, knindex)
    760     call gath2cpl(cpl_albe, wri_albe, klon, knon,iim,jjm, knindex)
    761     call gath2cpl(cpl_taux, wri_taux, klon, knon,iim,jjm, knindex)
    762     call gath2cpl(cpl_tauy, wri_tauy, klon, knon,iim,jjm, knindex)
    763     call gath2cpl(cpl_ruis, wri_ruis, klon, knon,iim,jjm, knindex)
    764 !
    765 ! Passage des champs au coupleur
    766 !
    767     call intocpl(itime, iim, jjm , wri_sols, wri_nsol, wri_rain, wri_snow, &
    768       & wri_evap, wri_tsol, wri_fder, wri_albe, wri_taux, wri_tauy,       &
    769       & wri_ruis )
    770     cpl_sols = 0.
    771     cpl_nsol = 0.
    772     cpl_rain = 0.
    773     cpl_snow = 0.
    774     cpl_evap = 0.
    775     cpl_tsol = 0.
    776     cpl_fder = 0.
    777     cpl_albe = 0.
    778     cpl_taux = 0.
    779     cpl_tauy = 0.
    780     cpl_ruis = 0.
    781 
    782     call fromcpl(itime,(jjm+1)*iim,                                          &
    783      &        read_sst, read_sic, read_alb_sst, read_alb_sic)
    784     call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex)
    785     call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex)
    786     call cpl2gath(read_alb_sst, alb_new, klon, knon,iim,jjm, knindex)
    787     call cpl2gath(read_alb_sic, alb_ice, klon, knon,iim,jjm, knindex)
    788 ! transformer tamp_sic en pctsrf_new
    789 
    790     do ig = 1, klon
    791       IF (pctsrf(ig,is_oce) > epsfra .OR.            &
    792      &             pctsrf(ig,is_sic) > epsfra) THEN
    793             pctsrf_new(ig,is_oce) = pctsrf(ig,is_oce)    &
    794      &                        - (tamp_sic(ig)-pctsrf(ig,is_sic))
    795             pctsrf_new(ig,is_sic) = tamp_sic(ig)
    796       endif
    797     enddo
     950  else if (nisurf == is_sic) then
     951      call cpl2gath(read_sit, tsurf_new, klon, knon,iim,jjm, knindex)
     952      call cpl2gath(read_alb_sic, alb_new, klon, knon,iim,jjm, knindex)
    798953  endif
    799954
    … …  
    12781433!
    12791434    fonte_neige = (nisurf /= is_oce) .AND. &
    1280      & (snow(i) > 0. .OR. nisurf == is_sic .OR. nisurf == is_lic) &
     1435     & (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) &
    12811436     & .AND. (tsurf_new(i) >= RTT)
    12821437    if (fonte_neige) tsurf_new(i) = RTT 
    … …  
    14531608  real, dimension(klon)     :: tamp
    14541609
     1610  tamp = 0.
    14551611  do i = 1, knon
    14561612    ig = knindex(i)

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F

    r101 r105  
    1 c
     1C $Id$
    22C****
    3 C               *****************
    4 C               * OASIS ROUTINE *
    5 C               * ------------- *
    6 C               *****************
    73C
    84C**** *INICMA*  - Initialize coupled mode communication for atmosphere
    9 C
    10 C     Purpose:
    11 C     -------
    12 C     Exchange process identifiers and timestep information
    13 C     between AGCM, OGCM and COUPLER.
     5C                 and exchange some initial information with Oasis
    146C
    157C     Input:
    … …  
    179C       KASTP  : total number of timesteps in atmospheric model
    1810C       KEXCH  : frequency of exchange (in time steps)
    19 C       KSTEP  : timestep value (in seconds)
    20 C
    21 C     Method:
    22 C     ------
    23 C     Use named pipes(FIFO) to exchange process identifiers
    24 C     between the programs
    25 C
    26 C     Externals:
    27 C     ---------
    28 C     GETPID, MKNOD
    29 C
    30 C     Reference:
    31 C     ---------
    32 C     See Epicoa 0803 (1992)
    33 C
    34 C     Author:
    35 C     -------
    36 C     Laurent Terray  92-09-01
     11C       KSTEP  : length of timestep (in seconds)
    3712C
    3813C     -----------------------------------------------------------
    … …  
    4015      SUBROUTINE inicma(kastp,kexch,kstep)
    4116c
     17      INCLUDE 'param.h'
     18c
    4219      INTEGER kastp, kexch, kstep
    43 c
    44       INTEGER ime
    45       PARAMETER (ime = 1)
    46 
    4720      INTEGER iparal(3)
    48       INTEGER ifcpl, idt, info, imxtag, istep
    49 c
    50 #include "dimensions.h"
    51 #include "dimphy.h"
    52 #include "oasis.h"
    53 #include "clim.h"
    54 c
    55 c     Addition for SIPC CASE
    56 #include "param_sipc.h"
    57 #include "param_cou.h"
    58 #include "inc_sipc.h"
    59 #include "inc_cpl.h"
    60       CHARACTER*9 clpoolnam
    61       INTEGER ipoolhandle, imrc, ipoolsize, index, jf
     21      INTEGER ifcpl, idt, info, imxtag, istep, jf
     22c
     23      INCLUDE 'param_cou.h'
     24      INCLUDE 'inc_cpl.h'
    6225      CHARACTER*3 cljobnam      ! experiment name
    6326      CHARACTER*6 clmodnam      ! model name
     27c     EM: not used by Oasis2.4
     28CEM      CHARACTER*6 clbid(2)      ! for CLIM_Init call (not used)
     29CEM                                ! must be dimensioned by the number of models
     30CEM      INTEGER nbid(2)           ! for CLIM_Init call (not used)
     31CEM                                ! must be dimensioned by the number of models
    6432      CHARACTER*5 cloasis       ! coupler name (Oasis)
    65       INTEGER imess(4), imesso(4)
    66       INTEGER getpid, mknod ! system functions
    67       CHARACTER*80 clcmd
    68       CHARACTER*8 pipnom, fldnom
    69       INTEGER ierror, iretcode
    70 C
     33      INTEGER imess(4)
     34      INTEGER getpid            ! system functions
    7135      INTEGER nuout
     36CEM      LOGICAL llmodel
    7237      PARAMETER (nuout = 6)
    7338c
    74 C
    75 c
    76 
     39      INCLUDE 'clim.h'
     40      INCLUDE 'mpiclim.h'
     41c
     42      INCLUDE 'oasis.h' ! contains the name of communication technique. Here
     43                        ! cchan=CLIM only is possible.
     44c                       ! ctype=MPI2
     45c
    7746C     -----------------------------------------------------------
    7847C
    … …  
    8756      WRITE(nuout,*) ' '
    8857c
    89 c     1.2.1-Define the model name
    90 c
    91       clmodnam = 'lmd.xx'       ! as $NBMODEL in namcouple
    92 c
    93 c     1.2.2-Define the coupler name
    94 c
    95       cloasis = 'Oasis'        !  as in coupler
    96 c
    97 c
    98 c     1.3.1-Define symbolic name for fields exchanged from atmos to coupler,
     58c     Define the model name
     59c
     60      clmodnam = 'toyatm'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
     61c
     62c     Define the coupler name
     63c
     64      cloasis = 'Oasis'        !  always 'Oasis' as in the coupler
     65c
     66c
     67c     Define symbolic name for fields exchanged from atmos to coupler,
    9968c         must be the same as (1) of the field  definition in namcouple:
    10069c
    101       cl_writ(1)='CONSFTOT'
    102       cl_writ(2)='COSHFTOT'
    103       cl_writ(3)='COTOPRSU'
    104       cl_writ(4)='COTFSHSU'
    105       cl_writ(5)='CORUNCOA'
    106       cl_writ(6)='CORIVFLU'
    107       cl_writ(7)='COZOTAUX'
    108       cl_writ(8)='COZOTAU2'
    109       cl_writ(9)='COMETAUY'
    110       cl_writ(10)='COMETAU2'
    111 c
    112 c     1.3.2-Define files name for fields exchanged from atmos to coupler,
     70      cl_writ(1)='COSHFICE'
     71      cl_writ(2)='COSHFOCE'
     72      cl_writ(3)='CONSFICE'
     73      cl_writ(4)='CONSFOCE'
     74      cl_writ(5)='CODFLXDT'
     75c      cl_writ(6)='COICTEMP'
     76      cl_writ(6)='COTFSICE'
     77      cl_writ(7)='COTFSOCE'
     78      cl_writ(8)='COTOLPSU'
     79      cl_writ(9)='COTOSPSU'
     80      cl_writ(10)='CORUNCOA'
     81      cl_writ(11)='CORIVFLU'
     82      cl_writ(12)='COZOTAUX'
     83      cl_writ(13)='COZOTAUV'
     84      cl_writ(14)='COMETAUY'
     85      cl_writ(15)='COMETAUU'
     86c
     87c     Define files name for fields exchanged from atmos to coupler,
    11388c         must be the same as (6) of the field  definition in namcouple:
    11489c
    115       cl_f_writ(1)='atmflx'
    116       cl_f_writ(2)='atmflx'
    117       cl_f_writ(3)='atmflx'
    118       cl_f_writ(4)='atmflx'
    119       cl_f_writ(5)='atmflx'
    120       cl_f_writ(6)='atmflx'
    121       cl_f_writ(7)='atmtau'
    122       cl_f_writ(8)='atmtau'
    123       cl_f_writ(9)='atmtau'
    124       cl_f_writ(10)='atmtau'
    125 c
    126 c
    127 c     1.4.1-Define symbolic name for fields exchanged from coupler to atmosphere,
     90      cl_f_writ(1)='flxatmos'
     91      cl_f_writ(2)='flxatmos'
     92      cl_f_writ(3)='flxatmos'
     93      cl_f_writ(4)='flxatmos'
     94      cl_f_writ(5)='flxatmos'
     95      cl_f_writ(6)='flxatmos'
     96      cl_f_writ(7)='flxatmos'
     97      cl_f_writ(8)='flxatmos'
     98      cl_f_writ(9)='flxatmos'
     99      cl_f_writ(10)='flxatmos'
     100      cl_f_writ(11)='flxatmos'
     101      cl_f_writ(12)='flxatmos'
     102      cl_f_writ(13)='flxatmos'
     103      cl_f_writ(14)='flxatmos'
     104      cl_f_writ(15)='flxatmos'
     105c      cl_f_writ(16)='flxatmos'
     106c
     107c
     108c     Define symbolic name for fields exchanged from coupler to atmosphere,
    128109c         must be the same as (2) of the field  definition in namcouple:
    129110c
    130       cl_read(1)='SISUTESU'
     111      cl_read(1)='SISUTESW'
    131112      cl_read(2)='SIICECOV'
    132 c
    133 c     1.4.2-Define files names for fields exchanged from coupler to atmosphere,
     113      cl_read(3)='SIICEALW'
     114      cl_read(4)='SIICTEMW'
     115c
     116c     Define files names for fields exchanged from coupler to atmosphere,
    134117c         must be the same as (7) of the field  definition in namcouple:
    135118c
    136       cl_f_read(1)='atmsst'
    137       cl_f_read(2)='atmice'
    138 c
    139 c     1.5-Define infos for sending to oasis
    140 c
    141       imess(1) = kastp
    142       imess(2) = kexch
    143       imess(3) = kstep
    144       imess(4) = getpid()
    145 
    146 c
    147 c
    148       IF (cchan.eq.'PIPE') THEN
    149 c
    150           ierror=0
    151 c
    152 c
    153           WRITE(nuout,*) ' '
    154           WRITE(nuout,*) 'Making pipes for fields to receive from CPL'
    155           WRITE(nuout,*) ' '
    156 c
    157 c loop to define pipes (ocean=CPL to atmos)
    158 c
    159           DO jf=1, jpfldo2a
    160             CALL PIPE_Model_Define(nuout, cl_read(jf), jpread, iretcode)
    161             IF (iretcode.ne.0) ierror=ierror+1
    162           END DO
    163 c
    164           WRITE(nuout,*) ' '
    165           WRITE(nuout,*) 'Making pipes for fields to send to CPL'
    166           WRITE(nuout,*) ' '
    167 c
    168 c loop to define pipes (atmos to ocean=CPL)
    169 c
    170           DO jf=1, jpflda2o
    171             CALL PIPE_Model_Define(nuout, cl_writ(jf), jpwrit, iretcode)
    172             IF (iretcode.ne.0) ierror=ierror+1
    173           END DO
    174 c
    175           IF (ierror.ne.0) THEN
    176               WRITE (nuout,*) 'Error in pipes definitions'
    177               WRITE (nuout,*) 'STOP inicma'
    178               CALL abort
    179           END IF
    180 c
    181           WRITE(nuout,*) ' '
    182           WRITE(nuout,*) 'All pipes have been made'
    183           WRITE(nuout,*) ' '
    184 c
    185           WRITE(nuout,*) ' '
    186           WRITE(nuout,*) 'Communication test between ATM and CPL'
    187           WRITE(nuout,*) ' '
    188           CALL flush(nuout)
    189 c
    190           CALL PIPE_Model_Stepi(nuout, imess, ime, imesso, ierror)
    191 c
    192           IF (ierror.ne.0) THEN
    193               WRITE (nuout,*)
    194      $            'Error in exchange first informations with Oasis'
    195               WRITE (nuout,*) 'STOP inicma'
    196               CALL abort
    197           END IF
    198 c
    199           WRITE(nuout,*) ' '
    200           WRITE(nuout,*) 'Communication test between ATM and CPL is OK'
    201           WRITE(nuout,*) ' total simulation time in oasis = ', imesso(1)
    202           WRITE(nuout,*) ' total number of iterations is  = ', imesso(2)
    203           WRITE(nuout,*) ' value of oasis timestep  is    = ', imesso(3)
    204           WRITE(nuout,*) ' process id for oasis  is       = ', imesso(4)
    205           WRITE(nuout,*) ' '
    206           CALL flush(nuout)
    207 c
    208       ELSE  IF (cchan.eq.'SIPC') THEN
    209 c
    210 c debug for more information
    211 c
    212 c          CALL SVIPC_debug(1)
    213 c 
    214 c
    215 c     1.1-Define the experiment name :
    216 c
    217           cljobnam = 'IPC'      ! as $JOBNAM in namcouple
    218 c
    219 c         3-Attach to shared memory pool used to exchange initial infos
    220 c
    221           imrc = 0
    222           CALL SIPC_Init_Model (cljobnam, clmodnam, 1, imrc)
    223           IF (imrc .NE. 0) THEN
    224             WRITE (nuout,*)'   '
    225             WRITE (nuout,*)'WARNING: Problem with attachement to', imrc
    226             WRITE (nuout,*)'         initial memory pool(s) in atmos'
    227             WRITE (nuout,*)'   '
    228             CALL ABORT('STOP in atmos')
    229           ENDIF
    230 c
    231 c         4-Attach to pools used to exchange fields from atmos to coupler
    232 c
    233           DO jf = 1, jpflda2o
    234 c
    235 C
    236 c           Pool name:
    237             clpoolnam = 'P'//cl_writ(jf)
    238 C
    239             CALL SIPC_Attach(clpoolnam, ipoolhandle)
    240 c     
    241 c           Resulting pool handle:
    242             mpoolwrit(jf) = ipoolhandle 
    243 C
    244             END DO
    245 C
    246 c         5-Attach to pools used to exchange fields from coupler to atmos
    247 c
    248           DO jf = 1, jpfldo2a
    249 c
    250 c           Pool name:
    251             clpoolnam = 'P'//cl_read(jf)
    252 c
    253             CALL SIPC_Attach(clpoolnam, ipoolhandle)
    254 c
    255 c           Resulting pool handle:
    256             mpoolread(jf) = ipoolhandle 
    257 c
    258           END DO
    259 c
    260 c         6-Exchange of initial infos
    261 c
    262 c         Write data array isend to pool READ by Oasis
    263 c
    264           imrc = 0
    265           ipoolsize = 4*jpbyteint
    266           CALL SVIPC_Write(mpoolinitr, imess, ipoolsize, imrc)
    267 C
    268 C         Find error if any
    269 C
    270           IF (imrc .LT. 0) THEN
    271               WRITE (nuout,*) '   '
    272               WRITE (nuout,*) 'Problem in atmos in writing initial'
    273               WRITE (nuout,*) 'infos to the shared memory segment(s)'
    274               WRITE (nuout,*) '   '
    275           ELSE
    276               WRITE (nuout,*) '   '
    277               WRITE (nuout,*) 'Initial infos written in atmos'           
    278               WRITE (nuout,*) 'to the shared memory segment(s)'
    279               WRITE (nuout,*) '   '
    280           ENDIF
    281 C
    282 C         Read data array irecv from pool written by Oasis
    283 C
    284           imrc = 0
    285           ipoolsize = 4*jpbyteint
    286           CALL SVIPC_Read(mpoolinitw, imesso, ipoolsize, imrc)
    287 C
    288 C*        Find error if any
    289 C
    290           IF (imrc .LT. 0) THEN
    291               WRITE (nuout,*) '   '
    292               WRITE (nuout,*) 'Problem in atmos in reading initial'
    293               WRITE (nuout,*) 'infos from the shared memory segment(s)'
    294               WRITE (nuout,*) '   '
    295           ELSE
    296               WRITE (nuout,*) '   '
    297               WRITE (nuout,*) 'Initial infos read by atmos'               
    298               WRITE (nuout,*) 'from the shared memory segment(s)'
    299               WRITE (nuout,*) '   '
    300               WRITE(*,*) ' ntime, niter, nstep, Oasis pid:'
    301               WRITE(*,*) imesso(1), imesso(2), imesso(3), imesso(4)
    302           ENDIF
    303 C
    304 C         Detach from shared memory segment(s)
    305 C
    306           imrc = 0
    307           CALL SVIPC_close(mpoolinitw, 0, imrc)
    308 C
    309 C         Find error if any
    310 C
    311           IF (imrc .LT. 0) THEN
    312               WRITE (nuout,*)
    313      $          'Problem in detaching from shared memory segment(s)'
    314               WRITE (nuout,*)
    315      $          'used by atmos to read initial infos'
    316           ENDIF
    317 c
    318 c
    319       ELSE IF (cchan.eq.'CLIM') THEN
    320 
    321 c
    322 c     1.1-Define the experiment name :
     119      cl_f_read(1)='sstatmos'
     120      cl_f_read(2)='sstatmos'
     121      cl_f_read(3)='sstatmos'
     122      cl_f_read(4)='sstatmos'
     123c
     124c
     125c     Define the number of processors involved in the coupling for
     126c     Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
     127c     in the namcouple); they will be stored in a COMMON in mpiclim.h
     128c     (used for CLIM/MPI2 only)
     129      mpi_nproc(0)=1
     130      mpi_nproc(1)=1
     131      mpi_nproc(2)=1
     132c
     133c     Define infos to be sent initially to oasis
     134c
     135      imess(1) = kastp      ! total number of timesteps in atmospheric model
     136      imess(2) = kexch      ! period of exchange (in time steps)
     137      imess(3) = kstep      ! length of atmospheric timestep (in seconds)
     138      imess(4) = getpid()   ! PID of atmospheric model
     139c
     140c     Initialization and exchange of initial info in the CLIM technique
     141c
     142      IF (cchan.eq.'CLIM') THEN
     143c
     144c     Define the experiment name :
    323145c
    324146          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
    325 
    326           OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown',
    327      $          FORM = 'formatted')
     147c
     148c         Start the coupling
     149c         (see lib/clim/src/CLIM_Init for the definition of input parameters)
     150c
     151cEM          clbid(1)='      '
     152cEM          clbid(2)='      '
     153cEM          nbid(1)=0
     154cEM          nbid(2)=0
     155CEM          llmodel=.true.
     156c
     157c         Define the number of processors used by each model as in
     158c         $CHATYPE line of namcouple (used for CLIM/MPI2 only)
     159          mpi_totproc(1)=1
     160          mpi_totproc(2)=1
     161c
     162c         Define names of each model as in $NBMODEL line of namcouple
     163c         (used for CLIM/MPI2 only)       
     164          cmpi_modnam(1)='toyatm'
     165          cmpi_modnam(2)='toyoce'
     166c         Start the coupling
     167c
    328168          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
    329169     *                 kastp, kexch, kstep,
    330170     *                 5, 3600, 3600, info )
    331171c
    332           IF (info.ne.clim_ok) THEN
     172          IF (info.ne.CLIM_Ok) THEN
    333173              WRITE ( nuout, *) ' inicma : pb init clim '
    334174              WRITE ( nuout, *) ' error code is = ', info
    335               CALL abort('STOP in inicma')
     175              CALL halte('STOP in inicma')
    336176            ELSE
    337177              WRITE(nuout,*) 'inicma : init clim ok '
    338178          ENDIF
    339179c
    340           iparal ( clim_strategy ) = clim_serial
    341           iparal ( clim_length   ) = iim*(jjm+1)
     180c         For each coupling field, association of a port to its symbolic name
     181c
     182c         -Define the parallel decomposition associated to the port of each
     183c          field; here no decomposition for all ports.
     184          iparal ( clim_strategy ) = clim_serial
     185          iparal ( clim_length   ) = imjm
    342186          iparal ( clim_offset   ) = 0
    343187c
    344 c loop to define messages (CPL=ocean to atmos)
    345 c
     188c         -Loop on total number of coupler-to-atmosphere fields
     189c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
    346190          DO jf=1, jpfldo2a
    347191            CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
    348192     $          , info ) 
    349193          END DO
    350 
    351 c
    352 c loop to define messages (atmos to ocean=CPL)
    353 c
    354           DO jf=1, jpflda2o
     194c
     195c         -Loop on total number of atmosphere-to-coupler fields
     196c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
     197          DO jf=1, jpflda2o1+jpflda2o2
    355198            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
    356199     $          iparal, info )   
    357200          END DO
    358 
     201c
    359202          WRITE(nuout,*) 'inicma : clim_define ok '
     203c
     204c         -Join a pvm group, wait for other programs and broadcast usefull
     205c          informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start)
    360206          CALL CLIM_Start ( imxtag, info )
    361207          IF (info.ne.clim_ok) THEN
    362208              WRITE ( nuout, *) 'inicma : pb start clim '
    363209              WRITE ( nuout, *) ' error code is = ', info
    364               CALL abort('stop in inicma')
     210              CALL halte('stop in inicma')
    365211            ELSE
    366212              WRITE ( nuout, *)  'inicma : start clim ok '
    367213          ENDIF
    368214c
     215c         -Get initial information from Oasis
     216c          (see lib/clim/src/CLIM_Stepi)
    369217          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
    370218          IF (info .NE. clim_ok) THEN
    … …  
    386234      END
    387235
    388       SUBROUTINE fromcpl(kt, imjm, sst,sic, alb_sst, alb_sic )
     236c $Id$
     237      SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo)
     238c ======================================================================
     239c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST
     240c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages)
     241c technique.
     242c======================================================================
    389243      IMPLICIT none
    390 c
    391 c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
    392 c provided by the coupler. Of course, it waits until it receives
    393 c the signal from the corresponding pipes.
    394 c 3 techniques:
    395 c  - pipes and signals (only on Cray C90 and Cray J90)
    396 c  - CLIM (PVM exchange messages)
    397 c  - SVIPC shared memory segments and semaphores
    398 c
    399244      INTEGER imjm, kt
    400245      REAL sst(imjm)          ! sea-surface-temperature
    401       REAL alb_sst(imjm)  ! open sea albedo
    402       REAL sic(imjm)      ! sea ice cover
    403       REAL alb_sic(imjm)  ! sea ice albedo
    404 
     246      REAL gla(imjm)          ! sea-ice
     247      REAL tice(imjm)          ! temp glace
     248      REAL albedo(imjm)          ! albedo glace
    405249c
    406250      INTEGER nuout             ! listing output unit
    … …  
    408252c
    409253      INTEGER nuread, ios, iflag, icpliter
    410       CHARACTER*8 pipnom        ! name for the pipe
    411       CHARACTER*8 fldnom        ! name for the field
    412       CHARACTER*8 filnom        ! name for the data file
    413 
    414254      INTEGER info, jf
    415 
    416 c
    417 #include "oasis.h"
    418 #include "clim.h"
    419 c
    420 #include "param_cou.h"
    421 c
    422 #include "inc_sipc.h"
    423 #include "inc_cpl.h"
    424 c
    425 c     Addition for SIPC CASE
    426       INTEGER index
    427       CHARACTER*3 cmodinf       ! Header or not
    428       CHARACTER*3 cljobnam_r    ! Experiment name in the field brick, if any
    429       INTEGER infos(3)          ! infos in the field brick, if any
     255c
     256      INCLUDE 'clim.h'
     257c
     258      INCLUDE 'oasis.h'
     259      INCLUDE 'param_cou.h'
     260c
     261      INCLUDE 'inc_cpl.h'
    430262c
    431263c
    432264      WRITE (nuout,*) ' '
    433       WRITE (nuout,*) 'Fromcpl: Read fields from CPL, kt=',kt
     265      WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
    434266      WRITE (nuout,*) ' '
    435267      CALL flush (nuout)
    436268
    437       IF (cchan.eq.'PIPE') THEN
    438 c
    439 c UNIT number for fields
    440 c
    441           nuread = 99
    442 c
    443 c exchanges from ocean=CPL to atmosphere
     269
     270      IF (cchan.eq.'CLIM') THEN
     271
     272c
     273c     -Get interpolated oceanic fields from Oasis
    444274c
    445275          DO jf=1,jpfldo2a
    446             CALL PIPE_Model_Recv(cl_read(jf), icpliter, nuout)
    447             OPEN (nuread, FILE=cl_f_read(jf), FORM='UNFORMATTED')
    448             IF (jf.eq.1)
    449      $          CALL locread(cl_read(jf), sst, imjm, nuread, iflag,
    450      $          nuout)
    451             IF (jf.eq.2)
    452      $          CALL locread(cl_read(jf), sic, imjm, nuread, iflag,
    453      $          nuout)
    454             IF (jf.eq.3)
    455      $          CALL locread(cl_read(jf), alb_sst, imjm, nuread, iflag,
    456      $          nuout)
    457             IF (jf.eq.4)
    458      $          CALL locread(cl_read(jf), alb_sic, imjm, nuread, iflag,
    459      $          nuout)
    460             CLOSE (nuread)
    461           END DO
    462 
    463 c
    464       ELSE IF (cchan.eq.'SIPC') THEN
    465 c
    466 c         Define IF a header must be encapsulated within the field brick :
    467           cmodinf = 'NOT'                 ! as $MODINFO in namcouple 
    468 c
    469 c         reading of input field sea-surface-temperature SISUTESU
    470 c
    471 c
    472 c         Index of sst in total number of fields jpfldo2a:
    473           index = 1
    474 c
    475           CALL SIPC_Read_Model(index, imjm, cmodinf,
    476      $              cljobnam_r,infos, sst)
    477 c
    478 c         reading of input field sea-ice SIICECOV
    479 c
    480 c
    481 c         Index of sea-ice in total number of fields jpfldo2a:
    482           index = 2
    483 c
    484           CALL SIPC_Read_Model(index, imjm, cmodinf,
    485      $              cljobnam_r,infos, sic)
    486 c         Index of open sea albedo in total number of fields jpfldo2a:
    487           index = 3
    488 c
    489           CALL SIPC_Read_Model(index, imjm, cmodinf,
    490      $              cljobnam_r,infos, alb_sst)
    491 c         Index of sea-ice albedo in total number of fields jpfldo2a:
    492           index = 4
    493 c
    494           CALL SIPC_Read_Model(index, imjm, cmodinf,
    495      $              cljobnam_r,infos, alb_sic)
    496 c
    497 c
    498       ELSE IF (cchan.eq.'CLIM') THEN
    499 
    500 c
    501 c exchanges from ocean=CPL to atmosphere
    502 c
    503         DO jf=1,jpfldo2a
    504           IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
    505           IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, sic, info)
    506          IF (jf.eq.3) CALL CLIM_Import (cl_read(jf) , kt, alb_sst, info)
    507          IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, alb_sic, info)
    508           IF ( info .NE. CLIM_Ok) THEN
     276            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
     277            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
     278            IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info)
     279            IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info)
     280            IF ( info .NE. CLIM_Ok) THEN
    509281                WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
    510282                WRITE(nuout,*)'Couplage kt is = ',kt
    511283                WRITE(nuout,*)'CLIM error code is = ', info
    512                 WRITE(nuout,*)'STOP in Fromcpl'
    513                 STOP 'Fromcpl'
     284                CALL halte('STOP in fromcpl.F')
    514285            ENDIF
    515286          END DO
    … …  
    520291      END
    521292
    522 
    523       SUBROUTINE intocpl(kt,imjm,
    524      .                   fsol, fnsol,
    525      .                   rain, snow, evap, ruisoce, ruisriv,
    526      .                   taux, tauy, last)
     293c $Id$
     294      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
     295     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
     296     $    tauxu, tauxv, tauyv, tauyu, last)
     297c ======================================================================
     298c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
     299c atmospheric coupling fields to the coupler with the CLIM (PVM exchange
     300c messages) technique.
     301c IF last time step, writes output fields to binary files.
     302c ======================================================================
    527303      IMPLICIT NONE
    528 c
    529 c Laurent Z.X Li (Feb. 10, 1997): It provides several fields to the
    530 c coupler. Of course, it sends a message to the corresponding pipes
    531 c after the writting.
    532 c 3 techniques : pipes
    533 c                clim
    534 c                svipc
    535 c IF last time step WRITE output files anway
    536 c
    537 #include "oasis.h"
    538 
    539304      INTEGER kt, imjm
    540305c
    541       REAL fsol(imjm)
    542       REAL fnsol(imjm)
    543       REAL rain(imjm)
    544       REAL snow(imjm)
    545       REAL evap(imjm)
    546       REAL ruisoce(imjm)
    547       REAL ruisriv(imjm)
    548       REAL taux(imjm)
    549       REAL tauy(imjm)
     306      REAL fsolice(imjm)
     307      REAL fsolwat(imjm)
     308      REAL fnsolice(imjm)
     309      REAL fnsolwat(imjm)
     310      REAL fnsicedt(imjm)
     311      REAL ictemp(imjm)
     312      REAL evice(imjm)
     313      REAL evwat(imjm)
     314      REAL lpre(imjm)
     315      REAL spre(imjm)
     316      REAL dirunoff(imjm)
     317      REAL rivrunoff(imjm)
     318      REAL tauxu(imjm)
     319      REAL tauxv(imjm)
     320      REAL tauyu(imjm)
     321      REAL tauyv(imjm)
    550322      LOGICAL last
    551323c
    … …  
    553325      PARAMETER (nuout = 6)
    554326c
    555 c Additions for SVIPC
    556 c
    557       INTEGER index
    558       INTEGER infos(3)
    559       CHARACTER*3 cmodinf       ! Header or not
    560       CHARACTER*3 cljobnam      ! experiment name
    561 c
    562 #include "clim.h"
    563 c
    564 #include "param_cou.h"
    565 c
    566 #include "inc_sipc.h"
    567 #include "inc_cpl.h"
    568 c
    569 C
    570       INTEGER nuwrit, ios
    571       CHARACTER*8 pipnom
    572       CHARACTER*8 fldnom
    573       CHARACTER*6 file_name(jpmaxfld)
     327      INCLUDE 'clim.h'
     328      INCLUDE 'param_cou.h'
     329      INCLUDE 'inc_cpl.h'
     330c
     331      CHARACTER*8 file_name(jpmaxfld)
    574332      INTEGER max_file
    575333      INTEGER file_unit_max, file_unit(jpmaxfld),
    … …  
    579337      LOGICAL trouve
    580338c
     339      INCLUDE 'oasis.h'
    581340c
    582341      icstep=kt
    583342c
    584343      WRITE(nuout,*) ' '
    585       WRITE(nuout,*) 'Intocpl: send fields to CPL, kt= ', kt
     344      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
    586345      WRITE(nuout,*) ' '
    587346
    588       IF (last.or.(cchan.eq.'PIPE')) THEN
    589 c
    590 c
    591 c WRITE fields for coupler with pipe technique or for last time step
    592 c
    593 c         initialisation
     347      IF (last) THEN
     348c
     349c     -WRITE fields to binary files for coupler restart at last time step
     350c
     351c         -initialisation and files opening
    594352c
    595353          max_file=1
    596354          file_unit_max=99
    597 c keeps first file name
     355c         -keeps first file name
    598356          file_name(max_file)=cl_f_writ(max_file)
    599 c keeps first file unit
     357c         -keeps first file unit
    600358          file_unit(max_file)=file_unit_max
    601 c decrements file unit maximum
     359c         -decrements file unit maximum
    602360          file_unit_max=file_unit_max-1
    603 c keeps file unit for field
     361c         -keeps file unit for field
    604362          file_unit_field(1)=file_unit(max_file)
    605363c
    606 c different files names counter
    607 c
    608          
    609           DO jf= 2, jpflda2o
     364c         -different files names counter
     365c
     366          DO jf= 2, jpflda2o1 + jpflda2o2
    610367            trouve=.false.
    611368            DO jn= 1, max_file
    612369              IF (.not.trouve) THEN
    613370                  IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
    614 c keep file unit for field
     371c                 -keep file unit for field
    615372                      file_unit_field(jf)=file_unit(jn)
    616373                      trouve=.true.
    … …  
    619376            END DO
    620377            IF (.not.trouve) then
    621 c increment the number of different files
     378c           -increment the number of different files
    622379                max_file=max_file+1
    623 c keep file name
     380c           -keep file name
    624381                file_name(max_file)=cl_f_writ(jf)
    625 c keep file unit for file
     382c           -keep file unit for file
    626383                file_unit(max_file)=file_unit_max
    627 c keep file unit for field
     384c           -keep file unit for field
    628385                file_unit_field(jf)=file_unit(max_file)
    629 c decrement unit maximum number from 99 to 98, ...
     386c           -decrement unit maximum number from 99 to 98, ...
    630387                file_unit_max=file_unit_max-1
    631388            END IF
    632389          END DO
    633          
     390c         
    634391          DO jn=1, max_file
    635392            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
    636           END DO
    637          
    638           DO jf=1, jpflda2o
     393          END DO
     394c
     395c         WRITE fields to files         
     396          DO jf=1, jpflda2o1 + jpflda2o2
    639397            IF (jf.eq.1)
    640      $          CALL locwrite(cl_writ(jf),fnsol, imjm,
     398     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
    641399     $          file_unit_field(jf), ierror, nuout)
    642400            IF (jf.eq.2)
    643      $          CALL locwrite(cl_writ(jf),fsol, imjm,
     401     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
    644402     $          file_unit_field(jf), ierror, nuout)
    645403            IF (jf.eq.3)
    646      $          CALL locwrite(cl_writ(jf),rain, imjm,
     404     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
    647405     $          file_unit_field(jf), ierror, nuout)
    648406            IF (jf.eq.4)
    649      $          CALL locwrite(cl_writ(jf),evap, imjm,
     407     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
    650408     $          file_unit_field(jf), ierror, nuout)
    651409            IF (jf.eq.5)
    652      $          CALL locwrite(cl_writ(jf),ruisoce, imjm,
     410     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
     411     $          file_unit_field(jf), ierror, nuout)
     412c            IF (jf.eq.6)
     413c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
     414c     $          file_unit_field(jf), ierror, nuout)
     415            IF (jf.eq.6)
     416     $          CALL locwrite(cl_writ(jf),evice, imjm,
     417     $          file_unit_field(jf), ierror, nuout)
     418            IF (jf.eq.7)
     419     $          CALL locwrite(cl_writ(jf),evwat, imjm,
     420     $          file_unit_field(jf), ierror, nuout)
     421            IF (jf.eq.8)
     422     $          CALL locwrite(cl_writ(jf),lpre, imjm,
     423     $          file_unit_field(jf), ierror, nuout)
     424            IF (jf.eq.9)
     425     $          CALL locwrite(cl_writ(jf),spre, imjm,
     426     $          file_unit_field(jf), ierror, nuout)
     427            IF (jf.eq.10)
     428     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
     429     $          file_unit_field(jf), ierror, nuout)
     430            IF (jf.eq.11)
     431     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
     432     $          file_unit_field(jf), ierror, nuout)
     433            IF (jf.eq.12)
     434     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
    653435     $          file_unit_field(jf),ierror, nuout)
    654             IF (jf.eq.6)
    655      $          CALL locwrite(cl_writ(jf),ruisriv, imjm,
     436            IF (jf.eq.13)
     437     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
    656438     $          file_unit_field(jf),ierror, nuout)
    657             IF (jf.eq.7)
    658      $          CALL locwrite(cl_writ(jf),taux, imjm,
    659      $          file_unit_field(jf), ierror, nuout)
    660             IF (jf.eq.8)
    661      $          CALL locwrite(cl_writ(jf),taux, imjm,
    662      $          file_unit_field(jf), ierror, nuout)
    663             IF (jf.eq.9)
    664      $          CALL locwrite(cl_writ(jf),tauy, imjm,
    665      $          file_unit_field(jf), ierror, nuout)
    666             IF (jf.eq.10)
    667      $          CALL locwrite(cl_writ(jf),tauy, imjm,
    668      $          file_unit_field(jf), ierror, nuout)
    669           END DO
    670 C
    671 C simulate a FLUSH
     439            IF (jf.eq.14)
     440     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
     441     $          file_unit_field(jf),ierror, nuout)
     442            IF (jf.eq.15)
     443     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
     444     $          file_unit_field(jf), ierror, nuout)
     445          END DO
     446C
     447C         -simulate a FLUSH
    672448C
    673449          DO jn=1, max_file
    674450            CLOSE (file_unit(jn))
    675451          END DO
    676 c
    677 c
    678 c
     452C
     453C
    679454          IF(cchan.eq.'CLIM') THEN
    680 c
    681 c inform PVM daemon, I have finished
    682 c
     455C
     456C         -inform PVM daemon that message exchange is finished
     457C
    683458              CALL CLIM_Quit (CLIM_ContPvm, info)
    684459              IF (info .NE. CLIM_Ok) THEN
    … …  
    687462     $                info
    688463              ENDIF
    689              
    690464          END IF
     465          RETURN   
     466      END IF
     467C
     468      IF(cchan.eq.'CLIM') THEN
     469C
     470C     -Give atmospheric fields to Oasis
     471C
     472          DO jn=1, jpflda2o1 + jpflda2o2
     473C           
     474          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
     475          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
     476          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
     477          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
     478          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
     479c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
     480          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
     481          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
     482          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
     483          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
     484          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
     485          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
     486          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
     487          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
     488          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
     489          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
    691490         
    692       END IF
    693      
    694 c
    695 c IF last we have finished
    696 c
    697       IF (last) RETURN
    698      
    699       IF (cchan.eq.'PIPE') THEN
    700 c
    701 c Send message to pipes for CPL=ocean
    702 c
    703           DO jf=1, jpflda2o
    704             CALL PIPE_Model_Send(cl_writ(jf), kt, nuout)
    705           END DO
    706 c
    707 c
    708 c
    709       ELSE  IF(cchan.eq.'SIPC') THEN
    710 c
    711 c         Define IF a header must be encapsulated within the field brick :
    712           cmodinf = 'NOT'                 ! as $MODINFO in namcouple 
    713 c
    714 c         IF cmodinf = 'YES', define encapsulated infos to be exchanged
    715 c                 infos(1) = initial date
    716 c                 infos(2) = timestep
    717 c                 infos(3) = actual time
    718 c
    719 c         Writing of output field non solar heat flux CONSFTOT
    720 c
    721 c         Index of non solar heat flux in total number of fields jpflda2o:
    722           index = 1
    723 c   
    724           CALL SIPC_Write_Model(index, imjm, cmodinf,
    725      $                          cljobnam,infos,fnsol)
    726 c
    727 c
    728 c         Writing of output field solar heat flux COSHFTOT
    729 c
    730 c         Index of solar heat flux in total number of fields jpflda2o:
    731           index = 2
    732 c   
    733           CALL SIPC_Write_Model(index, imjm, cmodinf,
    734      $                          cljobnam,infos,fsol)
    735 c
    736 c         Writing of output field rain COTOPRSU
    737 c
    738 c         Index of rain in total number of fields jpflda2o:
    739           index = 3
    740 c   
    741           CALL SIPC_Write_Model(index, imjm, cmodinf,
    742      $                          cljobnam,infos, rain)
    743 c
    744 c         Writing of output field evap COTFSHSU
    745 c
    746 c         Index of evap in total number of fields jpflda2o:
    747           index = 4
    748 c   
    749           CALL SIPC_Write_Model(index, imjm, cmodinf,
    750      $                          cljobnam,infos, evap)
    751 c
    752 c         Writing of output field ruisoce CORUNCOA
    753 c
    754 c         Index of ruisoce in total number of fields jpflda2o:
    755           index = 5
    756 c   
    757           CALL SIPC_Write_Model(index, imjm, cmodinf,
    758      $                          cljobnam,infos, ruisoce)
    759 c
    760 c
    761 c         Writing of output field ruisriv CORIVFLU
    762 c
    763 c         Index of ruisriv in total number of fields jpflda2o:
    764           index = 6
    765 c   
    766           CALL SIPC_Write_Model(index, imjm, cmodinf,
    767      $                          cljobnam,infos, ruisriv)
    768 c
    769 c
    770 c         Writing of output field zonal wind stress COZOTAUX
    771 c
    772 c         Index of runoff in total number of fields jpflda2o:
    773           index = 7
    774 c   
    775           CALL SIPC_Write_Model(index, imjm, cmodinf,
    776      $                          cljobnam,infos, taux)
    777 c
    778 c         Writing of output field meridional wind stress COMETAUY
    779 c
    780 c         Index of runoff in total number of fields jpflda2o:
    781           index = 8
    782 c   
    783           CALL SIPC_Write_Model(index, imjm, cmodinf,
    784      $                          cljobnam,infos, taux)
    785 c
    786 c
    787 c         Writing of output field zonal wind stress COMETAU2 (at v point)
    788 c
    789 c         Index of runoff in total number of fields jpflda2o:
    790           index = 9
    791 c   
    792           CALL SIPC_Write_Model(index, imjm, cmodinf,
    793      $                          cljobnam,infos, tauy)
    794 c
    795 c         Writing of output field meridional wind stress COMETAU2
    796 c
    797 c         Index of runoff in total number of fields jpflda2o:
    798           index = 10
    799 c   
    800           CALL SIPC_Write_Model(index, imjm, cmodinf,
    801      $                          cljobnam,infos, tauy)
    802 c
    803 c
    804       ELSE IF(cchan.eq.'CLIM') THEN
    805          
    806           DO jn=1, jpflda2o
    807            
    808             IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fnsol, info)
    809             IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsol, info)
    810             IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, rain, info)
    811             IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, evap, info)
    812             IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, ruisoce, info
    813      $          )
    814             IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ruisriv, info
    815      $          )
    816             IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
    817             IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
    818             IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
    819             IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
    820            
    821491            IF (info .NE. CLIM_Ok) THEN
    822492                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
    823493                WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
    824494                WRITE (nuout,*) 'Clim error code is = ',info
    825                 WRITE (nuout,*) 'STOP in intocpl '
    826                 CALL abort(' intocpl ')
     495                CALL halte('STOP in intocpl ')
    827496            ENDIF
    828            
    829           END DO
    830          
     497          END DO
    831498      ENDIF
    832 c
     499C
    833500      RETURN
    834501      END
    835502
    836       SUBROUTINE locread
    837       print *, 'Attention dans oasis.F, locread est non defini'
    838       RETURN
    839       END
    840 
    841       SUBROUTINE locwrite
    842       print *, 'Attention dans oasis.F, locwrite est non defini'
    843       RETURN
    844       END
    845 
    846       SUBROUTINE pipe_model_define
    847       print*,'Attention dans oasis.F, pipe_model_define est non defini'
    848       RETURN
    849       END
    850 
    851       SUBROUTINE pipe_model_stepi
    852       print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
    853       RETURN
    854       END
    855 
    856       SUBROUTINE pipe_model_recv
    857       print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
    858       RETURN
    859       END
    860 
    861       SUBROUTINE pipe_model_send
    862       print *, 'Attention dans oasis.F, pipe_model_send est non defini'
    863       RETURN
    864       END
    865 
    866 
    867       SUBROUTINE sipc_init_model
    868       print *, 'Attention dans oasis.F, sipc_init_model est non defini'
    869       RETURN
    870       END
    871 
    872       SUBROUTINE svipc_write
    873       print *, 'Attention dans oasis.F, svipc_write est non defini'
    874       RETURN
    875       END
    876 
    877       SUBROUTINE clim_export
    878       print *, 'Attention dans oasis.F, clim_export est non defini'
    879       RETURN
    880       END
    881 
    882       SUBROUTINE clim_init
    883       print *, 'Attention dans oasis.F, clim_init est non defini'
    884       RETURN
    885       END
    886 
    887       SUBROUTINE sipc_write_model
    888       print *, 'Attention dans oasis.F, sipc_write_model est non defini'
    889       RETURN
    890       END
    891 
    892       SUBROUTINE clim_start
    893       print *, 'Attention dans oasis.F, clim_start est non defini'
    894       RETURN
    895       END
    896 
    897       SUBROUTINE clim_define
    898       print *, 'Attention dans oasis.F, clim_define est non defini'
    899       RETURN
    900       END
    901 
    902       SUBROUTINE sipc_attach
    903       print *, 'Attention dans oasis.F, sipc_attach est non defini'
    904       RETURN
    905       END
    906 
    907       SUBROUTINE clim_import
    908       print *, 'Attention dans oasis.F, clim_import est non defini'
    909       RETURN
    910       END
    911 
    912       SUBROUTINE svipc_read
    913       print *, 'Attention dans oasis.F, svipc_read est non defini'
    914       RETURN
    915       END
    916 
    917       SUBROUTINE clim_stepi
    918       print *, 'Attention dans oasis.F, clim_stepi est non defini'
    919       RETURN
    920       END
    921 
    922       SUBROUTINE sipc_read_model
    923       print *, 'Attention dans oasis.F, sipc_read_model est non defini'
    924       RETURN
    925       END
    926 
    927       SUBROUTINE svipc_close
    928       print *, 'Attention dans oasis.F, svipc_close est non defini'
    929       RETURN
    930       END
    931 
    932       SUBROUTINE clim_quit
    933       print *, 'Attention dans oasis.F, clim_quit est non defini'
    934       RETURN
    935       END
    936 
Note: See TracChangeset for help on using the changeset viewer.