New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 359 for trunk/NEMO/OPA_SRC/restart_dimg.h90 – NEMO

Ignore:
Timestamp:
2005-12-21T11:46:45+01:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_033 : RB + CT : Add new surface pressure gradient algorithms

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/restart_dimg.h90

    r311 r359  
    22   !!                     ***  restart_dimg.h90  ***  
    33   !!--------------------------------------------------------------------- 
     4   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     5   !! $Header$  
     6   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     7   !!---------------------------------------------------------------------- 
    48 
    59   SUBROUTINE rst_write(kt) 
    … …  
    2428     !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl 
    2529     !!   8.5  !  03-06  (J.M. Molines)  F90: Free form, mpp support 
     30     !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    2631     !!---------------------------------------------------------------------- 
    2732     !! * Arguments  
    … …  
    4045 
    4146     REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk 
    42      !!---------------------------------------------------------------------- 
    43      !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    44      !! $Header$  
    45      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4647     !!---------------------------------------------------------------------- 
    4748 
    … …  
    8889       IF ( lk_ice_lim                           )   ios1 = 1 
    8990       IF ( l_bulk                               )   ios2 = 1 
    90        IF ( lk_dynspg_fsc .OR. lk_dynspg_fsc_tsk )   ios3 = 1 
     91       IF ( lk_dynspg_flt                        )   ios3 = 1 
    9192       IF ( lk_cpl                               )   ios4 = 1 
    9293 
    … …  
    102103 
    103104       ! 'before' fields 
    104  
    105        DO jk = 1, jpk 
    106           WRITE(inum,REC=irec) ub(:,:,jk) 
    107           irec = irec +1 
    108        END DO 
    109  
    110        DO jk = 1, jpk 
    111           WRITE(inum,REC=irec) vb(:,:,jk) 
    112           irec = irec +1 
    113        END DO 
    114  
    115        DO jk = 1, jpk 
    116           WRITE(inum,REC=irec) tb(:,:,jk) 
    117           irec = irec +1 
    118        END DO 
    119  
    120        DO jk = 1, jpk 
    121           WRITE(inum,REC=irec) sb(:,:,jk) 
    122           irec = irec +1 
    123        END DO 
    124  
    125        DO jk = 1, jpk 
    126           WRITE(inum,REC=irec) rotb(:,:,jk) 
    127           irec = irec +1 
    128        END DO 
    129  
    130        DO jk = 1, jpk 
    131           WRITE(inum,REC=irec) hdivb(:,:,jk) 
    132           irec = irec +1 
     105       DO jk = 1, jpk 
     106          WRITE(inum,REC=irec) ub(:,:,jk)   ;    irec = irec +1 
     107       END DO 
     108       DO jk = 1, jpk 
     109          WRITE(inum,REC=irec) vb(:,:,jk)   ;    irec = irec +1 
     110       END DO 
     111       DO jk = 1, jpk 
     112          WRITE(inum,REC=irec) tb(:,:,jk)   ;    irec = irec +1 
     113       END DO 
     114       DO jk = 1, jpk 
     115          WRITE(inum,REC=irec) sb(:,:,jk)   ;    irec = irec +1 
     116       END DO 
     117       DO jk = 1, jpk 
     118          WRITE(inum,REC=irec) rotb(:,:,jk)   ;    irec = irec +1 
     119       END DO 
     120       DO jk = 1, jpk 
     121          WRITE(inum,REC=irec) hdivb(:,:,jk)   ;    irec = irec +1 
    133122       END DO 
    134123 
    135124       ! 'now' fields 
    136  
    137        DO jk = 1, jpk 
    138           WRITE(inum,REC=irec) un(:,:,jk) 
    139           irec = irec +1 
    140        END DO 
    141  
    142        DO jk = 1, jpk 
    143           WRITE(inum,REC=irec) vn(:,:,jk) 
    144           irec = irec +1 
    145        END DO 
    146  
    147        DO jk = 1, jpk 
    148           WRITE(inum,REC=irec) tn(:,:,jk) 
    149           irec = irec +1 
    150        END DO 
    151  
    152        DO jk = 1, jpk 
    153           WRITE(inum,REC=irec) sn(:,:,jk) 
    154           irec = irec +1 
    155        END DO 
    156  
    157        DO jk = 1, jpk 
    158           WRITE(inum,REC=irec) rotn(:,:,jk) 
    159           irec = irec +1 
    160        END DO 
    161  
    162        DO jk = 1, jpk 
    163           WRITE(inum,REC=irec) hdivn(:,:,jk) 
    164           irec = irec +1 
     125       DO jk = 1, jpk 
     126          WRITE(inum,REC=irec) un(:,:,jk)   ;   irec = irec +1 
     127       END DO 
     128       DO jk = 1, jpk 
     129          WRITE(inum,REC=irec) vn(:,:,jk)   ;   irec = irec +1 
     130       END DO 
     131       DO jk = 1, jpk 
     132          WRITE(inum,REC=irec) tn(:,:,jk)   ;   irec = irec +1 
     133       END DO 
     134       DO jk = 1, jpk 
     135          WRITE(inum,REC=irec) sn(:,:,jk)   ;   irec = irec +1 
     136       END DO 
     137       DO jk = 1, jpk 
     138          WRITE(inum,REC=irec) rotn(:,:,jk)   ;   irec = irec +1 
     139       END DO 
     140       DO jk = 1, jpk 
     141          WRITE(inum,REC=irec) hdivn(:,:,jk)   ;   irec = irec +1 
    165142       END DO 
    166143 
    167144       ! elliptic solver arrays 
    168        WRITE(inum,REC=irec ) gcx(1:jpi,1:jpj) 
    169        irec = irec +1 
    170  
    171        WRITE(inum,REC=irec ) gcxb(1:jpi,1:jpj) 
    172        irec = irec +1 
    173  
    174 #if defined key_dynspg_fsc 
    175  
     145       WRITE(inum,REC=irec ) gcx(1:jpi,1:jpj)   ;   irec = irec +1 
     146       WRITE(inum,REC=irec ) gcxb(1:jpi,1:jpj)   ;   irec = irec +1 
     147#if defined key_dynspg_rl 
     148       ! Rigid-lid formulation (bsf) 
     149       WRITE(inum,REC=irec ) bsfb(:,:)   ;   irec = irec +1 
     150       WRITE(inum,REC=irec ) bsfn(:,:)   ;   irec = irec +1 
     151       WRITE(inum,REC=irec ) bsfd(:,:)   ;   irec = irec +1 
     152# else 
    176153       ! free surface formulation (ssh) 
    177  
    178        WRITE(inum,REC=irec ) sshb(:,:) 
    179        irec = irec +1 
    180  
    181        WRITE(inum,REC=irec ) sshn(:,:) 
    182        irec = irec +1 
    183 #else 
    184  
    185        ! Rigid-lid formulation (bsf) 
    186  
    187        WRITE(inum,REC=irec ) bsfb(:,:) 
    188        irec = irec +1 
    189  
    190        WRITE(inum,REC=irec ) bsfn(:,:) 
    191        irec = irec +1 
    192  
    193        WRITE(inum,REC=irec ) bsfd(:,:) 
    194        irec = irec +1 
    195  
     154       WRITE(inum,REC=irec ) sshb(:,:)   ;   irec = irec +1 
     155       WRITE(inum,REC=irec ) sshn(:,:)   ;   irec = irec +1 
     156# if defined key_dynspg_ts 
     157       ! free surface formulation issued from barotropic loop 
     158       WRITE(inum,REC=irec ) sshb_b(:,:)   ;   irec = irec +1 
     159       WRITE(inum,REC=irec ) sshn_b(:,:)   ;   irec = irec +1 
     160 
     161       ! horizontal transports issued from barotropic loop 
     162       WRITE(inum,REC=irec) un_b(:,:)   ;   irec = irec +1 
     163       WRITE(inum,REC=irec) vn_b(:,:)   ;   irec = irec +1 
     164# endif 
    196165#endif 
    197166 
    198167       ! TKE arrays 
    199  
    200168#if defined key_zdftke 
    201169         DO jk = 1, jpk 
    202             WRITE(inum,REC=irec) en(:,:,jk) ; irec = irec + 1  
     170            WRITE(inum,REC=irec) en(:,:,jk)   ;  irec = irec + 1  
    203171         END DO 
    204172#endif 
    … …  
    206174#if defined key_ice_lim 
    207175          zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model 
    208           WRITE(inum,REC=irec) zfice(:)     ; irec = irec + 1 
    209           WRITE(inum,REC=irec) sst_io(:,:)  ; irec = irec + 1 
    210           WRITE(inum,REC=irec) sss_io(:,:)  ; irec = irec + 1 
    211           WRITE(inum,REC=irec) u_io  (:,:)  ; irec = irec + 1 
    212           WRITE(inum,REC=irec) v_io  (:,:)  ; irec = irec + 1 
     176          WRITE(inum,REC=irec) zfice(:)      ;  irec = irec + 1 
     177          WRITE(inum,REC=irec) sst_io(:,:)   ;  irec = irec + 1 
     178          WRITE(inum,REC=irec) sss_io(:,:)   ;  irec = irec + 1 
     179          WRITE(inum,REC=irec) u_io  (:,:)   ;  irec = irec + 1 
     180          WRITE(inum,REC=irec) v_io  (:,:)   ;  irec = irec + 1 
    213181#    if defined key_coupled 
    214           WRITE(inum,REC=irec) alb_ice(:,:)  ; irec = irec + 1 
     182          WRITE(inum,REC=irec) alb_ice(:,:)  ;   irec = irec + 1 
    215183#    endif 
    216184#endif 
    217185# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    218186          zfblk(1) = FLOAT( nfbulk )                                 ! Bulk 
    219           WRITE(inum,REC=irec) zfblk(:)   ; irec = irec + 1 
    220           WRITE(inum,REC=irec) gsst(:,:)  ; irec = irec + 1 
     187          WRITE(inum,REC=irec) zfblk(:)   ;   irec = irec + 1 
     188          WRITE(inum,REC=irec) gsst(:,:)  ;   irec = irec + 1 
    221189# endif 
    222190 
    … …  
    225193 
    226194  END SUBROUTINE rst_write 
     195 
    227196 
    228197  SUBROUTINE rst_read 
    229198    !!--------------------------------------------------------------------- 
    230     !!                       ROUTINE rst_read 
    231     !!                     ****************** 
     199    !!                  ***  ROUTINE rst_read  *** 
    232200    !! ** Purpose : 
    233201    !!        Read restart fields in direct access format, one per process 
    234202    !! 
    235     !! ** Method : 
    236     !!        Just does the oposit than rst_wri 
     203    !! ** Method :   Just does the opposit than rst_wri 
    237204    !! 
    238205    !! History : 
    … …  
    245212    !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl 
    246213    !!   8.5  !  03-06  (J.M. Molines)  F90: Free form, mpp support 
    247     !!---------------------------------------------------------------------- 
    248  
    249  
     214    !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    250215    !!---------------------------------------------------------------------- 
    251216    USE lib_mpp 
    … …  
    264229    LOGICAL   :: lstop 
    265230 
    266       REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk 
    267  
    268     !!---------------------------------------------------------------------- 
    269     !!  OPA 8.5, LODYC-IPSL (2002) 
     231    REAL(wp), DIMENSION( 1) ::   zfice, zfblk   ! used only in case of ice & bulk 
    270232    !!---------------------------------------------------------------------- 
    271233 
    … …  
    316278    ! -------------- 
    317279 
    318  
    319     READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1, & 
    320      &  iice1, ibulk1, ios1, ios2, ios3, ios4, & 
    321      &  idast1, adatrj0,  ipi,ipj,ipk,ipni,ipnj,ipnij,iarea 
     280    READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1,   & 
     281       &             iice1, ibulk1, ios1, ios2, ios3, ios4,    & 
     282       &             idast1, adatrj0,  ipi,ipj,ipk,ipni,ipnj,ipnij,iarea 
    322283 
    323284    ! Performs checks on the file 
    … …  
    393354 
    394355    ! 'before' fields 
    395  
    396     DO jk = 1, jpk 
    397        READ(inum,REC=irec) ub(:,:,jk) 
    398        irec = irec +1 
    399     END DO 
    400  
    401     DO jk = 1, jpk 
    402        READ(inum,REC=irec) vb(:,:,jk) 
    403        irec = irec +1 
    404     END DO 
    405  
    406     DO jk = 1, jpk 
    407        READ(inum,REC=irec) tb(:,:,jk) 
    408        irec = irec +1 
    409     END DO 
    410  
    411     DO jk = 1, jpk 
    412        READ(inum,REC=irec) sb(:,:,jk) 
    413        irec = irec +1 
    414     END DO 
    415  
    416     DO jk = 1, jpk 
    417        READ(inum,REC=irec) rotb(:,:,jk) 
    418        irec = irec +1 
    419     END DO 
    420  
    421     DO jk = 1, jpk 
    422        READ(inum,REC=irec) hdivb(:,:,jk) 
    423        irec = irec +1 
     356    DO jk = 1, jpk 
     357       READ(inum,REC=irec) ub(:,:,jk)   ;   irec = irec +1 
     358    END DO 
     359    DO jk = 1, jpk 
     360       READ(inum,REC=irec) vb(:,:,jk)   ;   irec = irec +1 
     361    END DO 
     362    DO jk = 1, jpk 
     363       READ(inum,REC=irec) tb(:,:,jk)   ;   irec = irec +1 
     364    END DO 
     365    DO jk = 1, jpk 
     366       READ(inum,REC=irec) sb(:,:,jk)   ;   irec = irec +1 
     367    END DO 
     368    DO jk = 1, jpk 
     369       READ(inum,REC=irec) rotb(:,:,jk)   ;   irec = irec +1 
     370    END DO 
     371    DO jk = 1, jpk 
     372       READ(inum,REC=irec) hdivb(:,:,jk)   ;   irec = irec +1 
    424373    END DO 
    425374 
    426375    ! 'now' fields 
    427  
    428     DO jk = 1, jpk 
    429        READ(inum,REC=irec) un(:,:,jk) 
    430        irec = irec +1 
    431     END DO 
    432  
    433     DO jk = 1, jpk 
    434        READ(inum,REC=irec) vn(:,:,jk) 
    435        irec = irec +1 
    436     END DO 
    437  
    438     DO jk = 1, jpk 
    439        READ(inum,REC=irec) tn(:,:,jk) 
    440        irec = irec +1 
    441     END DO 
    442  
    443     DO jk = 1, jpk 
    444        READ(inum,REC=irec) sn(:,:,jk) 
    445        irec = irec +1 
    446     END DO 
    447  
    448     DO jk = 1, jpk 
    449        READ(inum,REC=irec) rotn(:,:,jk) 
    450        irec = irec +1 
    451     END DO 
    452  
    453     DO jk = 1, jpk 
    454        READ(inum,REC=irec) hdivn(:,:,jk) 
    455        irec = irec +1 
     376    DO jk = 1, jpk 
     377       READ(inum,REC=irec) un(:,:,jk)   ;   irec = irec +1 
     378    END DO 
     379    DO jk = 1, jpk 
     380       READ(inum,REC=irec) vn(:,:,jk)   ;   irec = irec +1 
     381    END DO 
     382    DO jk = 1, jpk 
     383       READ(inum,REC=irec) tn(:,:,jk)   ;   irec = irec +1 
     384    END DO 
     385    DO jk = 1, jpk 
     386       READ(inum,REC=irec) sn(:,:,jk)   ;   irec = irec +1 
     387    END DO 
     388    DO jk = 1, jpk 
     389       READ(inum,REC=irec) rotn(:,:,jk)   ;   irec = irec +1 
     390    END DO 
     391    DO jk = 1, jpk 
     392       READ(inum,REC=irec) hdivn(:,:,jk)   ;   irec = irec +1 
    456393    END DO 
    457394 
    458395    ! elliptic solver arrays 
    459     READ(inum,REC=irec ) gcx(1:jpi,1:jpj) 
    460     irec = irec +1 
    461  
    462     READ(inum,REC=irec ) gcxb(1:jpi,1:jpj) 
    463     irec = irec +1 
    464  
    465 #if defined key_dynspg_fsc 
    466  
     396    READ(inum,REC=irec ) gcx(1:jpi,1:jpj)   ;   irec = irec +1 
     397    READ(inum,REC=irec ) gcxb(1:jpi,1:jpj)   ;   irec = irec +1 
     398#if defined key_dynspg_rl 
     399    ! Rigid-lid formulation (bsf) 
     400    READ(inum,REC=irec ) bsfb(:,:)   ;   irec = irec +1 
     401    READ(inum,REC=irec ) bsfn(:,:)   ;   irec = irec +1 
     402    READ(inum,REC=irec ) bsfd(:,:)   ;   irec = irec +1 
     403#else 
    467404    ! free surface formulation (eta) 
    468  
    469     READ(inum,REC=irec ) sshb(:,:) 
    470     irec = irec +1 
    471  
    472     READ(inum,REC=irec ) sshn(:,:) 
    473     irec = irec +1 
    474 #else 
    475  
    476     ! Rigid-lid formulation (bsf) 
    477  
    478     READ(inum,REC=irec ) bsfb(:,:) 
    479     irec = irec +1 
    480  
    481     READ(inum,REC=irec ) bsfn(:,:) 
    482     irec = irec +1 
    483  
    484     READ(inum,REC=irec ) bsfd(:,:) 
    485     irec = irec +1 
    486  
     405    READ(inum,REC=irec ) sshb(:,:)   ;   irec = irec +1 
     406    READ(inum,REC=irec ) sshn(:,:)   ;   irec = irec +1 
     407# if defined key_dynspg_ts 
     408    ! free surface formulation issued from barotropic loop 
     409    READ(inum,REC=irec ) sshb_b(:,:)   ;   irec = irec +1 
     410    READ(inum,REC=irec ) sshn_b(:,:)   ;   irec = irec +1 
     411    ! horizontal transports issued from barotropic loop 
     412    READ(inum,REC=irec) un_b(:,:)   ;   irec = irec +1 
     413    READ(inum,REC=irec) vn_b(:,:)   ;   irec = irec +1 
     414# endif 
    487415#endif 
    488416 
    489417    ! TKE arrays 
    490  
    491418#if defined key_zdftke 
    492419    IF ( itke1 == 1 ) THEN 
    493420       DO jk = 1, jpk 
    494           READ(inum,REC=irec) en(:,:,jk) 
    495           irec = irec +1 
     421          READ(inum,REC=irec) en(:,:,jk)   ;   irec = irec +1 
    496422       END DO 
    497423    ELSE 
    … …  
    507433    ! check if it was in the previous run 
    508434    IF ( ios1 == 1 ) THEN 
    509        READ(inum,REC=irec) zfice(:)    ; irec = irec + 1 
    510        READ(inum,REC=irec) sst_io(:,:) ; irec = irec + 1 
    511        READ(inum,REC=irec) sss_io(:,:) ; irec = irec + 1 
    512        READ(inum,REC=irec) u_io  (:,:) ; irec = irec + 1 
    513        READ(inum,REC=irec) v_io  (:,:) ; irec = irec + 1 
    514 #  if defined key_coupled 
    515        READ(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1 
    516 #  endif 
     435       READ(inum,REC=irec) zfice(:)      ;  irec = irec + 1 
     436       READ(inum,REC=irec) sst_io(:,:)   ;  irec = irec + 1 
     437       READ(inum,REC=irec) sss_io(:,:)   ;  irec = irec + 1 
     438       READ(inum,REC=irec) u_io  (:,:)   ;  irec = irec + 1 
     439       READ(inum,REC=irec) v_io  (:,:)   ;  irec = irec + 1 
     440# if defined key_coupled 
     441       READ(inum,REC=irec) alb_ice(:,:)   ;  irec = irec + 1 
     442# endif 
    517443    ENDIF 
    518444    IF ( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN 
    … …  
    528454            END DO 
    529455         END DO 
    530 #    if defined key_coupled 
     456# if defined key_coupled 
    531457         alb_ice(:,:) = 0.8 * tmask(:,:,1) 
    532 #    endif 
    533     ENDIF 
    534    
    535 #endif 
    536 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
     458# endif 
     459    ENDIF 
     460#endif 
     461#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 
    537462      ! bulk forcing  
    538463      IF( ios2 == 1 ) THEN 
    … …  
    547472         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 ) 
    548473      ENDIF 
    549 # endif 
     474#endif 
    550475    CLOSE(inum) 
    551476  ! In case of restart with neuler = 0 then put all before fields = to now fields 
    … …  
    557482      rotb(:,:,:)=rotn(:,:,:) 
    558483      hdivb(:,:,:)=hdivn(:,:,:) 
    559 #if defined key_dynspg_fsc 
    560     ! free surface formulation (eta) 
    561       sshb(:,:)=sshn(:,:) 
     484#if defined key_dynspg_rl 
     485      bsfb(:,:)=bsfn(:,:)      ! rigid lid 
    562486#else 
    563     ! rigid lid 
    564       bsfb(:,:)=bsfn(:,:) 
    565 #endif 
    566     ENDIF 
    567  
     487      sshb(:,:)=sshn(:,:)      ! free surface formulation (eta) 
     488#endif 
     489    ENDIF 
    568490 
    569491  END SUBROUTINE rst_read 
Note: See TracChangeset for help on using the changeset viewer.