Changeset 4167


Ignore:
Timestamp:
12/03/18 16:45:53 (3 years ago)
Author:
omamce
Message:

O.M. : adapt area reading for ICO case

File:
1 edited

Legend:

Unmodified
Added
Removed
  • TOOLS/MOSAIX/src/MOSAIX/interpol.f90

    r4153 r4167  
    2222   CHARACTER (LEN=20) :: nchar, type_src, type_dst 
    2323   LOGICAL :: l_mask_src = .TRUE. , l_mask_dst = .TRUE., l_use_area = .FALSE. 
     24   LOGICAL :: l_src_is2D = .FALSE., l_src_is1D = .FALSE., l_src_is0D = .FALSE., l_dst_is2D = .FALSE. , l_dst_is1D = .FALSE., l_dst_is0D = .FALSE. 
    2425   ! 
    2526   REAL (kind=rl), PARAMETER :: rpi = ACOS ( -1.0_rl) 
     
    99100   SELECT CASE ( TRIM (type_src)) 
    100101   CASE ( "rectilinear" ) 
     102      l_src_is2D = .TRUE. 
    101103      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src rectilinear', 6I9)") rank 
    102104      CALL xios_get_domain_attr ("domain_src", lonvalue_1d=lon_src(:,1), latvalue_1d=lat_src(1,:) ) 
     
    104106      lat_src (:,:) = SPREAD ( lat_src(1,:), DIM=1, ncopies=nj_src) 
    105107   CASE default 
    106       IF ( nj_src == 1 .AND. ni_src==1) THEN 
    107          WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 2D ', 6I9)") rank 
     108      IF ( nj_src == 1 .AND. ni_src == 1) THEN 
     109         l_src_is0D = .TRUE. 
     110         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 0D ', 6I9)") rank 
    108111         CALL xios_get_domain_attr ("domain_src", lonvalue_2d=lon_src(:,:), latvalue_2d=lat_src(:,:) ) 
    109112      ELSE IF ( nj_src == 1 ) THEN 
     113         l_src_is1D = .TRUE. 
    110114         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 1D ', 6I9)") rank 
    111115         CALL xios_get_domain_attr ("domain_src", lonvalue_1d=lon_src(:,1), latvalue_1d=lat_src(:,1) ) 
    112116      ELSE 
     117         l_src_is2D = .TRUE. 
    113118         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 2D ', 6I9)") rank 
    114119         CALL xios_get_domain_attr ("domain_src", lonvalue_2d=lon_src(:,:), latvalue_2d=lat_src(:,:) ) 
     
    129134 
    130135   !< Read area on the source grid 
    131    ALLOCATE ( area_src (ni_src, nj_src) ) 
    132136   IF ( l_use_area ) THEN 
     137      IF ( l_src_is0D ) ALLOCATE ( area_src (  1   , 1     ) ) 
     138      IF ( l_src_is1D ) ALLOCATE ( area_src (  1   , ni_src) ) 
     139      IF ( l_src_is2D ) ALLOCATE ( area_src (ni_src, nj_src) ) 
    133140      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Receive field area_src')" ) rank 
    134       CALL xios_recv_field ("area_src", area_src) 
    135    ELSE 
    136       area_src (:,:) = 1 
    137    ENDIF 
    138    WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_src : ', 2E15.3)" ) rank, SUM(area_src) !, SUM(area_src, mask=lmask_src) 
    139     
    140    !< Read mask on the destination grid 
     141      CALL xios_recv_field ("area_src", area_src(:,:)) 
     142      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_src : ', 2E15.3)" ) rank, SUM(area_src) 
     143   ENDIF 
     144    
     145   !< Read characteristics of the destination grid 
    141146   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading domain_dst')" ) rank 
    142147   CALL xios_get_domain_attr ("domain_dst", ni=ni_dst, nj=nj_dst) 
    143148   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading domain_dst ', 6I7)") rank, ni_dst, nj_dst 
     149 
     150   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading type dst ', 6I9)") rank 
     151   CALL xios_get_domain_attr ("domain_dst", TYPE=type_dst ) 
     152   SELECT CASE ( TRIM (type_dst)) 
     153   CASE ( "rectilinear" ) 
     154      l_dst_is2D = .TRUE. 
     155      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Rectilinear dest domain 2D')") rank 
     156   CASE default 
     157      IF ( nj_dst == 1 .AND. ni_dst == 1) THEN 
     158         l_dst_is0D = .TRUE. 
     159         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 0D')") rank 
     160      ELSE IF ( nj_dst == 1 ) THEN 
     161         l_dst_is1D = .TRUE. 
     162         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 1D')") rank 
     163      ELSE 
     164         l_dst_is2D = .TRUE. 
     165         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 2D')") rank 
     166      ENDIF 
     167   END SELECT 
     168    
     169   !< Read mask on the destination grid 
    144170   ALLOCATE ( imask_dst (ni_dst, nj_dst), lmask_dst (ni_dst, nj_dst) ) 
    145171   IF ( l_mask_dst ) THEN 
     
    154180 
    155181   !< Read area on the destination grid 
    156    ALLOCATE ( area_dst (ni_dst, nj_dst) ) 
    157182   IF ( l_use_area ) THEN 
     183      IF ( l_dst_is0D ) ALLOCATE ( area_dst (  1   , 1     ) ) 
     184      IF ( l_dst_is1D ) ALLOCATE ( area_dst (  1   , ni_dst) ) 
     185      IF ( l_dst_is2D ) ALLOCATE ( area_dst (ni_dst, nj_dst) ) 
    158186      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- receive field area_dst')" ) rank  
    159       CALL xios_recv_field ("area_dst", area_dst) 
    160    ELSE 
    161       area_dst (:,:) = 1.0 
    162    ENDIF 
    163    WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Counting mask_dst : ', 2E15.3)" ) rank, SUM(area_dst) !, SUM(area_dst,mask=lmask_dst) 
    164  
     187      CALL xios_recv_field ("area_dst", area_dst(:,:)) 
     188      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_dst : ', 2E15.3)" ) rank, SUM(area_dst) 
     189   ENDIF 
     190    
    165191   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- End interpol_read (1)')") rank 
    166192   CALL xios_context_finalize () 
     
    178204   IF ( l_use_area ) CALL xios_set_domain_attr ("domain_src", area   =area_src ) 
    179205   !CALL xios_set_domain_attr ("domain_src", radius= 6371229.0 ) 
    180    WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- get attributes domain_src')" ) rank 
     206   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Get attributes domain_dst')" ) rank 
    181207   IF ( l_mask_dst ) CALL xios_set_domain_attr ("domain_dst", mask_2d=lmask_dst) 
    182208   IF ( l_use_area ) CALL xios_set_domain_attr ("domain_dst", area   =area_dst ) 
Note: See TracChangeset for help on using the changeset viewer.