Ignore:
Timestamp:
Jan 18, 2001, 4:47:37 PM (24 years ago)
Author:
lmdzadmin
Message:

Modifs pour l'utilisation du masque venant de l'ocean en cas de couple
LF

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ.3.3/branches/rel-LF/libf/dyn3d/etat0_netcdf.F

    r115 r174  
    66      IMPLICIT NONE
    77      !
     8#include "netcdf.inc"
    89#include "dimensions.h"
    910#include "paramet.h"
     
    8889      CHARACTER*80 :: visu_file
    8990      INTEGER :: visuid
     91
     92! pour la lecture du fichier masque ocean
     93      integer :: nid_o2a
     94      logical :: couple = .false.
     95      INTEGER :: iml_omask, jml_omask
     96      REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
     97      REAL, ALLOCATABLE, DIMENSION(:)  :: dlon_omask, dlat_omask
     98      REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
     99      real, dimension(klon) :: ocemask_fi
     100      integer :: isst(klon-2)
     101
    90102      !
    91103      !   Constantes
     
    213225      phis(:,:) = 0.0
    214226      CALL startget(varname, iip1, jjp1, rlonv, rlatu, phis, 0.0)
     227      write(*,*) 'Phis = '
     228      write(*,*)phis
    215229      !
    216230      varname = 'u'
     
    317331      rugsrel(:) = 0.0
    318332
     333C
     334C En cas de simulation couplee, lecture du masque ocean issu du modele ocean
     335C utilise pour calculer les poids et pour assurer l'adequation entre les
     336C fractions d'ocean vu par l'atmosphere et l'ocean
     337C
     338
     339      write(*,*)'Essai de lecture masque ocean'
     340      iret = nf_open("o2a.nc", NF_NOWRITE, nid_o2a)
     341      if (iret .ne. 0) then
     342        write(*,*)'ATTENTION!! pas de fichier o2a.nc trouve'
     343        write(*,*)'Run force'
     344      else
     345        couple = .true.
     346        iret = nf_close(nid_o2a)
     347        call flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp
     348     $    , nid_o2a)
     349        if (iml_omask /= iim .or. jml_omask /= jjp1) then
     350          write(*,*)'Dimensions non compatibles pour masque ocean'
     351          write(*,*)'iim = ',iim,' iml_omask = ',iml_omask
     352          write(*,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
     353          stop
     354        endif
     355        ALLOCATE(lat_omask(iml_omask, jml_omask), stat=iret)
     356        ALLOCATE(lon_omask(iml_omask, jml_omask), stat=iret)
     357        ALLOCATE(dlon_omask(iml_omask), stat=iret)
     358        ALLOCATE(dlat_omask(jml_omask), stat=iret)
     359        ALLOCATE(ocemask(iml_omask, jml_omask), stat=iret)
     360        ALLOCATE(ocetmp(iml_omask, jml_omask), stat=iret)
     361        CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp
     362     $    , lon_omask, lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
     363        CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp,
     364     $      ttm_tmp, 1, 1, ocetmp)
     365        CALL flinclo(fid)
     366        dlon_omask(1 : iml_omask) = lon_omask(1 : iml_omask, 1)
     367        dlat_omask(1 : jml_omask) = lat_omask(1 , 1 : jml_omask)
     368        ocemask = ocetmp
     369        if (dlat_omask(1) < dlat_omask(jml_omask)) then
     370          do j = 1, jml_omask
     371            ocemask(:,j) = ocetmp(:,jml_omask-j+1)
     372          enddo
     373        endif
     374C
     375C passage masque ocean a la grille physique
     376C
     377        ocemask_fi(1) = ocemask(1,1)
     378        do j = 2, jjm
     379          do i = 1, iim
     380            ocemask_fi((j-2)*iim + i + 1) = ocemask(i,j)
     381          enddo
     382        enddo
     383        ocemask_fi(klon) = ocemask(1,jjp1)
     384        zmasq = 1. - ocemask_fi
     385        isst = 0
     386        where (ocemask_fi(2:klon-1) >0.) isst = 1
     387        write(45,'(72i1)')isst
     388      endif
     389
    319390
    320391C
     
    384455C
    385456      pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon))
     457
     458
    386459      WHERE (pctsrf(1 : klon, is_oce) .LT. EPSFRA)
    387460          pctsrf(1 : klon, is_oce) = 0.
    388461      END WHERE
     462
     463      if (couple) pctsrf(1 : klon, is_oce) = ocemask_fi(1 : klon)
     464
     465      isst = 0
     466      where (pctsrf(2:klon-1,is_oce) >0.) isst = 1
     467      write(46,'(72i1)')isst
    389468C
    390469C verif que somme des sous surface = 1
Note: See TracChangeset for help on using the changeset viewer.