Changeset 4167

Timestamp:

12/03/18 16:45:53 (5 years ago)

Author:

omamce

Message:

O.M. : adapt area reading for ICO case

File:

• TOOLS/MOSAIX/src/MOSAIX/interpol.f90 (modified) (6 diffs)

TOOLS/MOSAIX/src/MOSAIX/interpol.f90

@@ -22 +22 @@
    CHARACTER (LEN=20) :: nchar, type_src, type_dst
    LOGICAL :: l_mask_src = .TRUE. , l_mask_dst = .TRUE., l_use_area = .FALSE.
+   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.
    !
    REAL (kind=rl), PARAMETER :: rpi = ACOS ( -1.0_rl)
@@ -99 +100 @@
    SELECT CASE ( TRIM (type_src))
    CASE ( "rectilinear" )
+      l_src_is2D = .TRUE.
       WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src rectilinear', 6I9)") rank
       CALL xios_get_domain_attr ("domain_src", lonvalue_1d=lon_src(:,1), latvalue_1d=lat_src(1,:) )
@@ -104 +106 @@
       lat_src (:,:) = SPREAD ( lat_src(1,:), DIM=1, ncopies=nj_src)
    CASE default
-      IF ( nj_src == 1 .AND. ni_src==1) THEN
-         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 2D ', 6I9)") rank
+      IF ( nj_src == 1 .AND. ni_src == 1) THEN
+         l_src_is0D = .TRUE.
+         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 0D ', 6I9)") rank
          CALL xios_get_domain_attr ("domain_src", lonvalue_2d=lon_src(:,:), latvalue_2d=lat_src(:,:) )
       ELSE IF ( nj_src == 1 ) THEN
+         l_src_is1D = .TRUE.
          WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 1D ', 6I9)") rank
          CALL xios_get_domain_attr ("domain_src", lonvalue_1d=lon_src(:,1), latvalue_1d=lat_src(:,1) )
       ELSE
+         l_src_is2D = .TRUE.
          WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading lon lat src 2D ', 6I9)") rank
          CALL xios_get_domain_attr ("domain_src", lonvalue_2d=lon_src(:,:), latvalue_2d=lat_src(:,:) )
@@ -129 +134 @@
 
    !< Read area on the source grid
-   ALLOCATE ( area_src (ni_src, nj_src) )
    IF ( l_use_area ) THEN
+      IF ( l_src_is0D ) ALLOCATE ( area_src (  1   , 1     ) )
+      IF ( l_src_is1D ) ALLOCATE ( area_src (  1   , ni_src) )
+      IF ( l_src_is2D ) ALLOCATE ( area_src (ni_src, nj_src) )
       WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Receive field area_src')" ) rank
-      CALL xios_recv_field ("area_src", area_src)
-   ELSE
-      area_src (:,:) = 1
-   ENDIF
-   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_src : ', 2E15.3)" ) rank, SUM(area_src) !, SUM(area_src, mask=lmask_src)
-   
-   !< Read mask on the destination grid
+      CALL xios_recv_field ("area_src", area_src(:,:))
+      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_src : ', 2E15.3)" ) rank, SUM(area_src)
+   ENDIF
+   
+   !< Read characteristics of the destination grid
    WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading domain_dst')" ) rank
    CALL xios_get_domain_attr ("domain_dst", ni=ni_dst, nj=nj_dst)
    WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading domain_dst ', 6I7)") rank, ni_dst, nj_dst
+
+   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Reading type dst ', 6I9)") rank
+   CALL xios_get_domain_attr ("domain_dst", TYPE=type_dst )
+   SELECT CASE ( TRIM (type_dst))
+   CASE ( "rectilinear" )
+      l_dst_is2D = .TRUE.
+      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Rectilinear dest domain 2D')") rank
+   CASE default
+      IF ( nj_dst == 1 .AND. ni_dst == 1) THEN
+         l_dst_is0D = .TRUE.
+         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 0D')") rank
+      ELSE IF ( nj_dst == 1 ) THEN
+         l_dst_is1D = .TRUE.
+         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 1D')") rank
+      ELSE
+         l_dst_is2D = .TRUE.
+         WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Domain dest 2D')") rank
+      ENDIF
+   END SELECT
+   
+   !< Read mask on the destination grid
    ALLOCATE ( imask_dst (ni_dst, nj_dst), lmask_dst (ni_dst, nj_dst) )
    IF ( l_mask_dst ) THEN
@@ -154 +180 @@
 
    !< Read area on the destination grid
-   ALLOCATE ( area_dst (ni_dst, nj_dst) )
    IF ( l_use_area ) THEN
+      IF ( l_dst_is0D ) ALLOCATE ( area_dst (  1   , 1     ) )
+      IF ( l_dst_is1D ) ALLOCATE ( area_dst (  1   , ni_dst) )
+      IF ( l_dst_is2D ) ALLOCATE ( area_dst (ni_dst, nj_dst) )
       WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- receive field area_dst')" ) rank 
-      CALL xios_recv_field ("area_dst", area_dst)
-   ELSE
-      area_dst (:,:) = 1.0
-   ENDIF
-   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Counting mask_dst : ', 2E15.3)" ) rank, SUM(area_dst) !, SUM(area_dst,mask=lmask_dst)
-
+      CALL xios_recv_field ("area_dst", area_dst(:,:))
+      WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Sum area_dst : ', 2E15.3)" ) rank, SUM(area_dst)
+   ENDIF
+   
    WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- End interpol_read (1)')") rank
    CALL xios_context_finalize ()
@@ -178 +204 @@
    IF ( l_use_area ) CALL xios_set_domain_attr ("domain_src", area   =area_src )
    !CALL xios_set_domain_attr ("domain_src", radius= 6371229.0 )
-   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- get attributes domain_src')" ) rank
+   WRITE (UNIT=nout, FMT="('-- ', 1I4.4, ' -- Get attributes domain_dst')" ) rank
    IF ( l_mask_dst ) CALL xios_set_domain_attr ("domain_dst", mask_2d=lmask_dst)
    IF ( l_use_area ) CALL xios_set_domain_attr ("domain_dst", area   =area_dst )