Ignore:
Timestamp:
Dec 14, 2015, 11:43:09 AM (9 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2298:2396 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/dyn3dmem/dynredem_mod.F90

    r1910 r2408  
    1 !
    2 ! $Id$
    3 !
    41MODULE dynredem_mod
    52
    6 CONTAINS
    7 
    8   SUBROUTINE dynredem_write_u(ncid,id,var,ll)
    93  USE dimensions_mod
    104  USE parallel_lmdz
    115  USE mod_hallo
    12   IMPLICIT NONE
    13     INTEGER          :: ncid
    14     CHARACTER(LEN=*) :: id
    15     REAL             :: var(ijb_u:ije_u,ll)
    16     REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
    17     REAL,ALLOCATABLE,SAVE  :: var_glo(:)
    18     INTEGER          :: ll
    19     INTEGER          :: count(4)
    20     INTEGER          :: start(4)
    21     INTEGER          :: l
    22     INTEGER          :: nvarid
    23     INTEGER          :: ierr
    24     INCLUDE 'netcdf.inc'   
     6  USE netcdf
     7  PRIVATE
     8  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
     9  PUBLIC :: cre_var, get_var1, put_var, fil, modname, msg
     10  CHARACTER(LEN=256), SAVE :: fil, modname
     11  INTEGER,            SAVE :: nvarid
     12
     13
     14CONTAINS
     15
     16
     17!===============================================================================
     18!
     19SUBROUTINE dynredem_write_u(ncid,id,var,ll)
     20!
     21!===============================================================================
     22  IMPLICIT NONE
     23!===============================================================================
     24! Arguments:
     25  INTEGER,          INTENT(IN) :: ncid
     26  CHARACTER(LEN=*), INTENT(IN) :: id
     27  REAL,             INTENT(IN) :: var(ijb_u:ije_u,ll)
     28  INTEGER,          INTENT(IN) :: ll
     29!===============================================================================
     30! Local variables:
     31  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
     32  INTEGER :: start(4), count(4), l, ierr
     33!===============================================================================
     34  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
     35
     36!$OMP MASTER
     37  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
     38!$OMP END MASTER
     39
     40!$OMP MASTER
     41  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
     42!$OMP END MASTER
     43!$OMP BARRIER
     44
     45!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     46  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
     47  DO l=1,ll
     48    CALL gather_field_u(var_tmp(:,l),var_glo,1)
     49    IF(mpi_rank==0) THEN
     50    !$OMP MASTER
     51      start(3)=l
     52      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
     53    !$OMP END MASTER
     54    END IF
     55  END DO
     56!$OMP BARRIER
     57!$OMP MASTER
     58  DEALLOCATE(var_glo,var_tmp)
     59!$OMP END MASTER
     60!$OMP BARRIER
     61 
     62END SUBROUTINE dynredem_write_u
     63!
     64!===============================================================================
     65
     66
     67!===============================================================================
     68!
     69SUBROUTINE dynredem_write_v(ncid,id,var,ll)
     70!
     71!===============================================================================
     72  IMPLICIT NONE
     73!===============================================================================
     74! Arguments:
     75  INTEGER,          INTENT(IN) :: ncid
     76  CHARACTER(LEN=*), INTENT(IN) :: id
     77  REAL,             INTENT(IN) :: var(ijb_v:ije_v,ll)
     78  INTEGER,          INTENT(IN) :: ll
     79!===============================================================================
     80! Local variables:
     81  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
     82  INTEGER :: start(4), count(4), l, ierr
     83!===============================================================================
     84  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,1,1]
     85
     86!$OMP MASTER
     87  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
     88!$OMP END MASTER
     89
     90!$OMP MASTER
     91  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
     92!$OMP END MASTER
     93!$OMP BARRIER
     94
     95!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     96  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
     97  DO l=1,ll
     98    CALL gather_field_v(var_tmp(:,l),var_glo,1)
     99    IF(mpi_rank==0) THEN
     100    !$OMP MASTER
     101      start(3)=l
     102      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
     103    !$OMP END MASTER
     104    END IF
     105  END DO
     106!$OMP BARRIER
     107!$OMP MASTER
     108  DEALLOCATE(var_glo,var_tmp)
     109!$OMP END MASTER
     110!$OMP BARRIER
     111 
     112END SUBROUTINE dynredem_write_v
     113!
     114!===============================================================================
     115
     116
     117!===============================================================================
     118!
     119SUBROUTINE dynredem_read_u(ncid,id,var,ll)
     120!
     121!===============================================================================
     122  IMPLICIT NONE
     123!===============================================================================
     124! Arguments:
     125  INTEGER,          INTENT(IN)  :: ncid
     126  CHARACTER(LEN=*), INTENT(IN)  :: id
     127  REAL,             INTENT(OUT) :: var(ijb_u:ije_u,ll)
     128  INTEGER,          INTENT(IN)  :: ll
     129!===============================================================================
     130! Local variables:
     131  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
     132  INTEGER :: start(4), count(4), l, ierr
     133!===============================================================================
     134  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
     135
     136!$OMP MASTER
     137  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),'inq',id)
     138!$OMP END MASTER
     139
     140!$OMP MASTER
     141  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
     142!$OMP END MASTER
     143!$OMP BARRIER
     144
     145  DO l=1,ll
     146    IF(mpi_rank==0) THEN
     147    !$OMP MASTER
     148      start(3)=l
     149      CALL err(NF90_GET_VAR(ncid,nvarid,var_glo,start,count),"get",id)
     150    !$OMP END MASTER
     151    END IF
     152    CALL scatter_field_u(var_glo,var_tmp(:,l),1)
     153  END DO
     154
     155!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     156  DO l=1,ll; var(:,l)=var_tmp(:,l); END DO
    25157   
    26     count(:)=(/ iip1,jjp1,1,1 /)
    27     start(:)=(/ 1,1,1,1 /)
    28    
    29 !$OMP MASTER   
    30    IF (mpi_rank==0) THEN
    31      ierr = NF_INQ_VARID(ncid, id, nvarid)
    32      IF (ierr .NE. NF_NOERR) THEN
    33        PRINT*, "Variable "//id//" n est pas definie"
    34        CALL abort
    35      ENDIF
    36    ENDIF
    37 !$OMP END MASTER
    38 
    39 !$OMP MASTER
    40     ALLOCATE(var_tmp(ijb_u:ije_u,ll))
    41     ALLOCATE(var_glo(ip1jmp1))
    42 !$OMP END MASTER
    43 !$OMP BARRIER
    44 
    45 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    46     DO l=1,ll
    47       var_tmp(:,l)=var(:,l)
    48     ENDDO
    49 
    50     DO l=1,ll
    51       CALL gather_field_u(var_tmp(:,l),var_glo,1)
    52        IF (mpi_rank==0) THEN
    53    !$OMP MASTER
    54         start(3)=l
     158!$OMP BARRIER
     159!$OMP MASTER
     160  DEALLOCATE(var_glo,var_tmp)
     161!$OMP END MASTER
     162!$OMP BARRIER
     163 
     164END SUBROUTINE dynredem_read_u   
     165!
     166!===============================================================================
     167
     168
     169!===============================================================================
     170!
     171SUBROUTINE cre_var(ncid,var,title,did,units)
     172!
     173!===============================================================================
     174  IMPLICIT NONE
     175!===============================================================================
     176! Arguments:
     177  INTEGER,                    INTENT(IN) :: ncid
     178  CHARACTER(LEN=*),           INTENT(IN) :: var, title
     179  INTEGER,                    INTENT(IN) :: did(:)
     180  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
     181!===============================================================================
    55182#ifdef NC_DOUBLE
    56         ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
     183  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
    57184#else
    58         ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
     185  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
    59186#endif
    60    !$OMP END MASTER
    61        ENDIF
    62     ENDDO
    63    
    64   !$OMP BARRIER
    65   !$OMP MASTER
    66     DEALLOCATE(var_tmp)
    67     DEALLOCATE(var_glo)
    68   !$OMP END MASTER
    69   !$OMP BARRIER
    70  
    71   END SUBROUTINE dynredem_write_u
    72      
    73   SUBROUTINE dynredem_write_v(ncid,id,var,ll)
    74   USE dimensions_mod
    75   USE parallel_lmdz
    76   USE mod_hallo
    77   IMPLICIT NONE
    78     INTEGER          :: ncid
    79     CHARACTER(LEN=*) :: id
    80     REAL             :: var(ijb_v:ije_v,ll)
    81     REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
    82     REAL,ALLOCATABLE,SAVE  :: var_glo(:)
    83     INTEGER          :: ll
    84     INTEGER          :: count(4)
    85     INTEGER          :: start(4)
    86     INTEGER          :: l
    87     INTEGER          :: nvarid
    88     INTEGER          :: ierr
    89     INCLUDE 'netcdf.inc'   
    90    
    91     count(:)=(/ iip1,jjm,1,1 /)
    92     start(:)=(/ 1,1,1,1 /)
    93    
    94 !$OMP MASTER   
    95    IF (mpi_rank==0) THEN
    96      ierr = NF_INQ_VARID(ncid, id, nvarid)
    97      IF (ierr .NE. NF_NOERR) THEN
    98        PRINT*, "Variable "//id//" n est pas definie"
    99        CALL abort
    100      ENDIF
    101    ENDIF
    102 !$OMP END MASTER
    103  
    104 !$OMP MASTER
    105     ALLOCATE(var_tmp(ijb_v:ije_v,ll))
    106     ALLOCATE(var_glo(ip1jm))
    107 !$OMP END MASTER
    108 !$OMP BARRIER
    109 
    110 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    111     DO l=1,ll
    112       var_tmp(:,l)=var(:,l)
    113     ENDDO
    114 
    115     DO l=1,ll
    116       CALL gather_field_v(var_tmp(:,l),var_glo,1)
    117        IF (mpi_rank==0) THEN
    118    !$OMP MASTER
    119         start(3)=l
    120 #ifdef NC_DOUBLE
    121         ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
    122 #else
    123         ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
    124 #endif
    125    !$OMP END MASTER
    126        ENDIF
    127     ENDDO
    128    
    129   !$OMP BARRIER
    130   !$OMP MASTER
    131     DEALLOCATE(var_tmp)
    132     DEALLOCATE(var_glo)
    133   !$OMP END MASTER
    134   !$OMP BARRIER
    135  
    136   END SUBROUTINE dynredem_write_v
    137 
    138   SUBROUTINE dynredem_read_u(ncid,id,var,ll)
    139   USE dimensions_mod
    140   USE parallel_lmdz
    141   USE mod_hallo
    142   IMPLICIT NONE
    143     INTEGER          :: ncid
    144     CHARACTER(LEN=*) :: id
    145     REAL             :: var(ijb_u:ije_u,ll)
    146     REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
    147     REAL,ALLOCATABLE,SAVE  :: var_glo(:)
    148     INTEGER          :: ll
    149     INTEGER          :: count(4)
    150     INTEGER          :: start(4)
    151     INTEGER          :: l
    152     INTEGER          :: nvarid
    153     INTEGER          :: ierr
    154     INCLUDE 'netcdf.inc'   
    155    
    156     count(:)=(/ iip1,jjp1,1,1 /)
    157     start(:)=(/ 1,1,1,1 /)
    158    
    159 !$OMP MASTER   
    160    IF (mpi_rank==0) THEN
    161      ierr = NF_INQ_VARID(ncid, id, nvarid)
    162      IF (ierr .NE. NF_NOERR) THEN
    163        PRINT*, "Variable "//id//" n est pas definie"
    164        CALL abort
    165      ENDIF
    166    ENDIF
    167 !$OMP END MASTER
    168  
    169 !$OMP MASTER
    170     ALLOCATE(var_tmp(ijb_u:ije_u,ll))
    171     ALLOCATE(var_glo(ip1jmp1))
    172 !$OMP END MASTER
    173 !$OMP BARRIER
    174 
    175 
    176     DO l=1,ll
    177        IF (mpi_rank==0) THEN
    178    !$OMP MASTER
    179         start(3)=l
    180 #ifdef NC_DOUBLE
    181         ierr = NF_GET_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
    182 #else
    183         ierr = NF_GET_VARA_REAL (ncid,nvarid,start,count,var_glo)
    184 #endif
    185    !$OMP END MASTER
    186        ENDIF
    187        CALL scatter_field_u(var_glo,var_tmp(:,l),1)
    188     ENDDO
    189 
    190 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    191     DO l=1,ll
    192       var(:,l)=var_tmp(:,l)
    193     ENDDO
    194    
    195   !$OMP BARRIER
    196   !$OMP MASTER
    197     DEALLOCATE(var_tmp)
    198     DEALLOCATE(var_glo)
    199   !$OMP END MASTER
    200   !$OMP BARRIER
    201  
    202   END SUBROUTINE dynredem_read_u   
    203  
     187  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
     188  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
     189
     190END SUBROUTINE cre_var
     191!
     192!===============================================================================
     193
     194
     195!===============================================================================
     196!
     197SUBROUTINE put_var(ncid,var,title,did,v,units)
     198!
     199!===============================================================================
     200  IMPLICIT NONE
     201!===============================================================================
     202! Arguments:
     203  INTEGER,                    INTENT(IN) :: ncid
     204  CHARACTER(LEN=*),           INTENT(IN) :: var, title
     205  INTEGER,                    INTENT(IN) :: did(:)
     206  REAL,                       INTENT(IN) :: v(:)
     207  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
     208!===============================================================================
     209  INTEGER :: nd, k, nn(2)
     210  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
     211  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
     212  CALL err(NF90_ENDDEF(ncid))
     213  nd=SIZE(did)
     214  DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO
     215  IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)
     216  IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)
     217  CALL err(NF90_REDEF(ncid))
     218END SUBROUTINE put_var
     219!
     220!===============================================================================
     221
     222
     223!===============================================================================
     224!
     225FUNCTION msg(typ,nam)
     226!
     227!===============================================================================
     228  IMPLICIT NONE
     229!===============================================================================
     230! Arguments:
     231  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
     232  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
     233  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
     234!===============================================================================
     235  SELECT CASE(typ)
     236    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
     237    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
     238    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
     239    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
     240    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
     241    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
     242  END SELECT
     243  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
     244
     245END FUNCTION msg
     246!
     247!===============================================================================
     248
     249
     250!===============================================================================
     251!
     252SUBROUTINE err(ierr,typ,nam)
     253!
     254!===============================================================================
     255  IMPLICIT NONE
     256!===============================================================================
     257! Arguments:
     258  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
     259  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
     260  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
     261!===============================================================================
     262  IF(ierr==NF90_NoERR) RETURN
     263  IF(.NOT.PRESENT(typ)) THEN
     264    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
     265  ELSE
     266    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
     267  END IF
     268
     269END SUBROUTINE err
     270!
     271!===============================================================================
     272
    204273END MODULE dynredem_mod   
     274
    205275   
    206276   
Note: See TracChangeset for help on using the changeset viewer.