/[lmdze]/trunk/Sources/phylmd/Interface_surf/interfoce_lim.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Interface_surf/interfoce_lim.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/phylmd/Interface_surf/interfoce_lim.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/Interface_surf/interfoce_lim.f revision 221 by guez, Thu Apr 20 14:44:47 2017 UTC
# Line 4  module interfoce_lim_m Line 4  module interfoce_lim_m
4    
5  contains  contains
6    
7    SUBROUTINE interfoce_lim(itime, dtime, jour,  &    SUBROUTINE interfoce_lim(jour, pctsrf_new_oce, pctsrf_new_sic)
        klon, nisurf, knon, knindex,  &  
        debut,  &  
        lmt_sst, pctsrf_new)  
   
     ! Cette routine sert d'interface entre le modele atmospherique et  
     ! un fichier de conditions aux limites  
   
     ! L. Fairhead 02/2000  
   
     use abort_gcm_m, only: abort_gcm  
     use indicesol  
     use netcdf  
   
     integer, intent(IN) :: itime ! numero du pas de temps courant  
     real , intent(IN) :: dtime ! pas de temps de la physique (en s)  
     integer, intent(IN) :: jour ! jour a lire dans l'annee  
     integer, intent(IN) :: nisurf ! index de la surface a traiter (1 = sol continental)  
     integer, intent(IN) :: knon ! nombre de points dans le domaine a traiter  
     integer, intent(IN) :: klon ! taille de la grille  
     integer, dimension(klon), intent(in) :: knindex ! index des points de la surface a traiter  
     logical, intent(IN) :: debut ! logical: 1er appel a la physique (initialisation)  
   
     ! Parametres de sortie  
     ! output:  
     ! lmt_sst SST lues dans le fichier de CL  
     ! pctsrf_new sous-maille fractionnelle  
     real, intent(out), dimension(klon) :: lmt_sst  
     real, intent(out), dimension(klon, nbsrf) :: pctsrf_new  
   
     ! Variables locales  
     integer :: ii  
     INTEGER, save :: lmt_pas ! frequence de lecture des conditions limites  
     ! (en pas de physique)  
     logical, save :: deja_lu ! pour indiquer que le jour a lire a deja  
     ! lu pour une surface precedente  
     integer, save :: jour_lu  
     integer :: ierr  
     character (len = 20) :: modname = 'interfoce_lim'  
     character (len = 80) :: abort_message  
     logical, save :: newlmt = .TRUE.  
     logical, save :: check = .FALSE.  
     ! Champs lus dans le fichier de CL  
     real, allocatable , save, dimension(:) :: sst_lu, rug_lu, nat_lu  
     real, allocatable , save, dimension(:, :) :: pct_tmp  
8    
9      ! quelques variables pour netcdf      ! lecture conditions limites
10        ! Cette routine sert d'interface entre le modèle atmosphérique et
11        ! un fichier de conditions aux limites.
12    
13      integer :: nid, nvarid      ! Laurent FAIRHEAD, February 2000
14      integer, dimension(2) :: start, epais  
15        USE netcdf, ONLY: nf90_nowrite
16        use netcdf95, only: NF95_CLOSE, nf95_get_var, NF95_INQ_VARID, nf95_open
17    
18        integer, intent(IN):: jour ! jour \`a lire dans l'ann\'ee
19    
20        real, intent(out):: pctsrf_new_oce(:), pctsrf_new_sic(:) ! (klon)
21        ! sous-maille fractionnelle
22    
23        ! Local:
24        integer ncid, varid ! pour NetCDF
25    
26      ! --------------------------------------------------      ! --------------------------------------------------
27    
28      if (debut .and. .not. allocated(sst_lu)) then      call NF95_OPEN ('limit.nc', NF90_NOWRITE, ncid)
29         lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour  
30         jour_lu = jour - 1      ! Fraction "ocean"
31         allocate(sst_lu(klon))      call NF95_INQ_VARID(ncid, 'FOCE', varid)
32         allocate(nat_lu(klon))      call NF95_GET_VAR(ncid, varid, pctsrf_new_oce, start = (/1, jour/))
33         allocate(pct_tmp(klon, nbsrf))  
34      endif      ! Fraction "glace de mer"
35        call NF95_INQ_VARID(ncid, 'FSIC', varid)
36      if ((jour - jour_lu) /= 0) deja_lu = .false.      call NF95_GET_VAR(ncid, varid, pctsrf_new_sic, start = (/1, jour/))
   
     if (check) write(*, *)modname, ' :: jour, jour_lu, deja_lu', jour, jour_lu, &  
          deja_lu  
     if (check) write(*, *)modname, ' :: itime, lmt_pas ', itime, lmt_pas, dtime  
   
     ! Tester d'abord si c'est le moment de lire le fichier  
     if (mod(itime-1, lmt_pas) == 0 .and. .not. deja_lu) then  
   
        ! Ouverture du fichier  
   
        ierr = NF90_OPEN ('limit.nc', NF90_NOWRITE, nid)  
        if (ierr.NE.NF90_NOERR) then  
           abort_message &  
                = 'Pb d''ouverture du fichier de conditions aux limites'  
           call abort_gcm(modname, abort_message, 1)  
        endif  
   
        ! La tranche de donnees a lire:  
   
        start(1) = 1  
        start(2) = jour  
        epais(1) = klon  
        epais(2) = 1  
   
        if (newlmt) then  
   
           ! Fraction "ocean"  
   
           ierr = NF90_INQ_VARID(nid, 'FOCE', nvarid)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Le champ <FOCE> est absent'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
           ierr = NF90_GET_VAR(nid, nvarid, pct_tmp(:, is_oce), start, epais)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Lecture echouee pour <FOCE>'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
   
           ! Fraction "glace de mer"  
   
           ierr = NF90_INQ_VARID(nid, 'FSIC', nvarid)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Le champ <FSIC> est absent'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
           ierr = NF90_GET_VAR(nid, nvarid, pct_tmp(:, is_sic), start, epais)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Lecture echouee pour <FSIC>'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
   
           ! Fraction "terre"  
   
           ierr = NF90_INQ_VARID(nid, 'FTER', nvarid)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Le champ <FTER> est absent'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
           ierr = NF90_GET_VAR(nid, nvarid, pct_tmp(:, is_ter), start, epais)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Lecture echouee pour <FTER>'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
   
           ! Fraction "glacier terre"  
   
           ierr = NF90_INQ_VARID(nid, 'FLIC', nvarid)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Le champ <FLIC> est absent'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
           ierr = NF90_GET_VAR(nid, nvarid, pct_tmp(:, is_lic), start, epais)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Lecture echouee pour <FLIC>'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
   
        else ! on en est toujours a rnatur  
   
           ierr = NF90_INQ_VARID(nid, 'NAT', nvarid)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Le champ <NAT> est absent'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
           ierr = NF90_GET_VAR(nid, nvarid, nat_lu, start, epais)  
           if (ierr /= NF90_NOERR) then  
              abort_message = 'Lecture echouee pour <NAT>'  
              call abort_gcm(modname, abort_message, 1)  
           endif  
   
           ! Remplissage des fractions de surface  
           ! nat = 0, 1, 2, 3 pour ocean, terre, glacier, seaice  
   
           pct_tmp = 0.0  
           do ii = 1, klon  
              pct_tmp(ii, nint(nat_lu(ii)) + 1) = 1.  
           enddo  
   
   
           ! On se retrouve avec ocean en 1 et terre en 2 alors qu'on veut le contraire  
   
           pctsrf_new = pct_tmp  
           pctsrf_new (:, 2)= pct_tmp (:, 1)  
           pctsrf_new (:, 1)= pct_tmp (:, 2)  
           pct_tmp = pctsrf_new  
        endif ! fin test sur newlmt  
   
        ! Lecture SST  
   
        ierr = NF90_INQ_VARID(nid, 'SST', nvarid)  
        if (ierr /= NF90_NOERR) then  
           abort_message = 'Le champ <SST> est absent'  
           call abort_gcm(modname, abort_message, 1)  
        endif  
        ierr = NF90_GET_VAR(nid, nvarid, sst_lu, start, epais)  
        if (ierr /= NF90_NOERR) then  
           abort_message = 'Lecture echouee pour <SST>'  
           call abort_gcm(modname, abort_message, 1)  
        endif  
   
   
        ! Fin de lecture  
   
        ierr = NF90_CLOSE(nid)  
        deja_lu = .true.  
        jour_lu = jour  
     endif  
   
     ! Recopie des variables dans les champs de sortie  
   
     lmt_sst = 999999999.  
     do ii = 1, knon  
        lmt_sst(ii) = sst_lu(knindex(ii))  
     enddo  
37    
38      pctsrf_new(:, is_oce) = pct_tmp(:, is_oce)      call NF95_CLOSE(ncid)
     pctsrf_new(:, is_sic) = pct_tmp(:, is_sic)  
39    
40    END SUBROUTINE interfoce_lim    END SUBROUTINE interfoce_lim
41    
Legend:
Removed from v.82  
changed lines
  Added in v.221
  ViewVC Help
Powered by ViewVC 1.1.21