!!--------------------------------------------------------------------- !! *** restart_dimg.h90 *** !!--------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Header$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- SUBROUTINE rst_write(kt) !!--------------------------------------------------------------------- !! *** ROUTINE rst_write *** !! !! ** Purpose : Write restart fields in direct access format in mpp. !! one per process !! !! ** Method : each nstock time step , save fields which are necessary !! for restart !! Record #1 hold general information on the state of the run !! Data fields (either 3D or 2D ) starts ar record #2 !! !! History : !! ! 91-03 () original code !! ! 91-11 (G. Madec) !! ! 92-06 (M. Imbard) correction restart file !! ! 92-07 (M. Imbard) split into diawri and rstwri !! ! 98-02 (M. Guyon) FETI method !! ! 98-05 (G. Roullet) free surface !! ! 99-11 (M. Imbard) NetCDF FORMAT with ioipsl !! 8.5 ! 03-06 (J.M. Molines) F90: Free form, mpp support !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time-step !! * Local declarations INTEGER :: ino0, it0, ipcg0, isor0, itke0 INTEGER :: irecl8, irec INTEGER :: jk ! dummy loop indices INTEGER :: inum = 11 ! temporary logical unit INTEGER :: ios1 , ios2 ! flag for ice and bulk in the current run INTEGER :: ios3 ! flag for free surface. 0 = none 1 = yes. 0 = none 1 = yes INTEGER :: ios4 ! flag for coupled (1) or not (0) CHARACTER(LEN=80) :: clres REAL(wp), DIMENSION( 1) :: zfice, zfblk ! used only in case of ice & bulk !!---------------------------------------------------------------------- IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN ! 0. Initializations ! ------------------ IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' rst_write: output done in inum = ', & inum,' at it= ',kt,' date= ',ndastp WRITE(numout,*) ' -------' ENDIF ! Open direct access file, with reclength for 2D wp fields irecl8= jpi * jpj * wp WRITE(clres,'(a,i3.3)') 'restart.output.',narea #if defined key_agrif inum = Agrif_Get_Unit() If(.NOT. Agrif_root() ) clres = TRIM(Agrif_CFixed())//'_'//TRIM(clres) #endif OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 ) ino0 = no it0 = kt ipcg0 = 0 isor0 = 0 itke0 = 0 isor0 = nsolv - 1 ipcg0 = 2 - nsolv IF ( lk_zdftke ) itke0=1 ! FETI method IF (nsolv == 3) THEN isor0 = 2 ipcg0 = 2 ENDIF ! 1. Write in inum ! ------------------ ! first record ios1 = 0 ios2 = 0 ios3 = 0 ios4 = 0 IF ( lk_ice_lim ) ios1 = 1 IF ( l_bulk ) ios2 = 1 IF ( lk_dynspg_flt ) ios3 = 1 IF ( lk_cpl ) ios4 = 1 WRITE(inum,REC=1) irecl8, ino0, it0, isor0, ipcg0, itke0, & & nfice, nfbulk , ios1, ios2, ios3, ios4, & & ndastp, adatrj, jpi, jpj, jpk, & & jpni, jpnj, jpnij, narea, jpiglo, jpjglo, & & nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! prognostic variables irec=2 ! 'before' fields DO jk = 1, jpk WRITE(inum,REC=irec) ub(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) vb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) tb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) sb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) rotb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) hdivb(:,:,jk) ; irec = irec +1 END DO ! 'now' fields DO jk = 1, jpk WRITE(inum,REC=irec) un(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) vn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) tn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) sn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) rotn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk WRITE(inum,REC=irec) hdivn(:,:,jk) ; irec = irec +1 END DO ! elliptic solver arrays WRITE(inum,REC=irec ) gcx(1:jpi,1:jpj) ; irec = irec +1 WRITE(inum,REC=irec ) gcxb(1:jpi,1:jpj) ; irec = irec +1 #if defined key_dynspg_rl ! Rigid-lid formulation (bsf) WRITE(inum,REC=irec ) bsfb(:,:) ; irec = irec +1 WRITE(inum,REC=irec ) bsfn(:,:) ; irec = irec +1 WRITE(inum,REC=irec ) bsfd(:,:) ; irec = irec +1 # else ! free surface formulation (ssh) WRITE(inum,REC=irec ) sshb(:,:) ; irec = irec +1 WRITE(inum,REC=irec ) sshn(:,:) ; irec = irec +1 # if defined key_dynspg_ts ! free surface formulation issued from barotropic loop WRITE(inum,REC=irec ) sshb_b(:,:) ; irec = irec +1 WRITE(inum,REC=irec ) sshn_b(:,:) ; irec = irec +1 ! horizontal transports issued from barotropic loop WRITE(inum,REC=irec) un_b(:,:) ; irec = irec +1 WRITE(inum,REC=irec) vn_b(:,:) ; irec = irec +1 # endif #endif ! TKE arrays #if defined key_zdftke DO jk = 1, jpk WRITE(inum,REC=irec) en(:,:,jk) ; irec = irec + 1 END DO #endif #if defined key_ice_lim zfice(1) = FLOAT( nfice ) ! Louvain La Neuve Sea Ice Model WRITE(inum,REC=irec) zfice(:) ; irec = irec + 1 WRITE(inum,REC=irec) sst_io(:,:) ; irec = irec + 1 WRITE(inum,REC=irec) sss_io(:,:) ; irec = irec + 1 WRITE(inum,REC=irec) u_io (:,:) ; irec = irec + 1 WRITE(inum,REC=irec) v_io (:,:) ; irec = irec + 1 # if defined key_coupled WRITE(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1 # endif #endif # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily zfblk(1) = FLOAT( nfbulk ) ! Bulk WRITE(inum,REC=irec) zfblk(:) ; irec = irec + 1 WRITE(inum,REC=irec) gsst(:,:) ; irec = irec + 1 # endif CLOSE(inum) ENDIF END SUBROUTINE rst_write SUBROUTINE rst_read !!--------------------------------------------------------------------- !! *** ROUTINE rst_read *** !! ** Purpose : !! Read restart fields in direct access format, one per process !! !! ** Method : Just does the opposit than rst_wri !! !! History : !! ! 91-03 () original code !! ! 91-11 (G. Madec) !! ! 92-06 (M. Imbard) correction restart file !! ! 92-07 (M. Imbard) split into diawri and rstwri !! ! 98-02 (M. Guyon) FETI method !! ! 98-05 (G. Roullet) free surface !! ! 99-11 (M. Imbard) NetCDF FORMAT with ioipsl !! 8.5 ! 03-06 (J.M. Molines) F90: Free form, mpp support !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- USE lib_mpp !! * Local declarations INTEGER :: ino0, it0, ipcg0, isor0, itke0 INTEGER :: ino1, it1, isor1, ipcg1, itke1, idast1 INTEGER :: iice1, ibulk1 INTEGER :: ipi,ipj,ipk, ipni,ipnj,ipnij,iarea INTEGER :: irecl8, irec INTEGER :: ji,jj,jk INTEGER :: ick, inum INTEGER :: ios1, ios2, ios3, ios4 CHARACTER(LEN=80) :: clres LOGICAL :: lstop REAL(wp), DIMENSION( 1) :: zfice, zfblk ! used only in case of ice & bulk !!---------------------------------------------------------------------- ! 0. Initialisations ! ------------------ inum = 11 ino0 = no it0 = nit000 ipcg0 = 0 isor0 = 0 itke0 = 0 isor0 = nsolv-1 ipcg0 = 2-nsolv IF (lk_zdftke ) itke0 = 1 ! FETI method IF( nsolv == 3 ) THEN isor0=2 ipcg0=2 ENDIF IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) ' *** rst_read: beginning of restart' WRITE(numout,*) ' ' WRITE(numout,*) ' the present run :' WRITE(numout,*) ' job number : ', no WRITE(numout,*) ' with nit000 : ', nit000 WRITE(numout,*) ' with pcg option ipcg0 : ', ipcg0 WRITE(numout,*) ' with sor option isor0 : ', isor0 WRITE(numout,*) ' with FETI solver option ipcg0 & isor0 : ', ipcg0,' & ',isor0 WRITE(numout,*) ' with tke option itke0 : ', itke0 WRITE(numout,*) ' with nfice : ', nfice WRITE(numout,*) ' with nfbulk : ', nfbulk ENDIF ! Open direct access file, with reclength for 2D wp fields WRITE(clres,'(a,i3.3)') 'restart.',narea #if defined key_agrif inum = Agrif_Get_Unit() If(.NOT. Agrif_root() ) clres = TRIM(Agrif_CFixed())//'_'//TRIM(clres) #endif OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=8 ) READ(inum,REC=1)irecl8 CLOSE(inum) OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 ) ! 1. Read inum ! -------------- READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1, & & iice1, ibulk1, ios1, ios2, ios3, ios4, & & idast1, adatrj0, ipi,ipj,ipk,ipni,ipnj,ipnij,iarea ! Performs checks on the file ! processor layout changed ? check only on lwp lstop =.FALSE. IF ( ipni /= jpni ) THEN lstop=.TRUE. IF (lwp) WRITE(numout,*) ' E R R O R : Processor splitting change along I ' IF (lwp) WRITE(numout,*) ' ==========' END IF IF ( ipnj /= jpnj ) THEN lstop=.TRUE. IF (lwp) WRITE(numout,*) ' E R R O R : Processor splitting change along J ' IF (lwp) WRITE(numout,*) ' ==========' END IF IF ( ipnij /= jpnij ) THEN lstop=.TRUE. IF (lwp) WRITE(numout,*) ' E R R O R : Total number of processors changed ' IF (lwp) WRITE(numout,*) ' ==========' END IF ick = narea -iarea CALL mpp_sum( ick ) IF (ick /= 0 ) THEN lstop=.TRUE. IF (lwp) WRITE(numout,*) ' E R R O R : mismatch in area numbering ...' IF (lwp) WRITE(numout,*) ' ==========' END IF IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) ' READ inum with ' WRITE(numout,*) ' job number : ', ino1 WRITE(numout,*) ' with time step it : ', it1 WRITE(numout,*) ' with pcg option ipcg1 : ', ipcg1 WRITE(numout,*) ' with sor option isor1 : ', isor1 WRITE(numout,*) ' with tke option itke1 : ', itke1 WRITE(numout,*) ' with FETI solver option ipcg1 + isor1 : ', ipcg1 + isor1 WRITE(numout,*) ENDIF ! Control of date IF( (it0-it1) /= 1 .AND. nrstdt /= 0 ) THEN lstop=.TRUE. IF(lwp) THEN WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart' WRITE(numout,*) ' ======= =======' WRITE(numout,*) ' we stop. verify the file' WRITE(numout,*) ' or rerun with the value 0 for the' WRITE(numout,*) ' control of time parameter nrstdt' WRITE(numout,*) ENDIF ENDIF IF ( nrstdt /= 2 ) THEN ! Compatibility with OPA8 ! the beginning of the new run is ndate0 read in the namelist ! adatrj0 is recalculated assuming constant time step. adatrj0 = ( FLOAT( nit000-1 ) * rdttra(1) ) / rday ELSE ! restart option nrstdt = 2 ! both adatrj0 and ndastp are read in the restart file. ndastp = idast1 ENDIF IF (lstop ) STOP 'rst_read' irec=2 ! 'before' fields DO jk = 1, jpk READ(inum,REC=irec) ub(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) vb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) tb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) sb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) rotb(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) hdivb(:,:,jk) ; irec = irec +1 END DO ! 'now' fields DO jk = 1, jpk READ(inum,REC=irec) un(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) vn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) tn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) sn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) rotn(:,:,jk) ; irec = irec +1 END DO DO jk = 1, jpk READ(inum,REC=irec) hdivn(:,:,jk) ; irec = irec +1 END DO ! elliptic solver arrays READ(inum,REC=irec ) gcx(1:jpi,1:jpj) ; irec = irec +1 READ(inum,REC=irec ) gcxb(1:jpi,1:jpj) ; irec = irec +1 #if defined key_dynspg_rl ! Rigid-lid formulation (bsf) READ(inum,REC=irec ) bsfb(:,:) ; irec = irec +1 READ(inum,REC=irec ) bsfn(:,:) ; irec = irec +1 READ(inum,REC=irec ) bsfd(:,:) ; irec = irec +1 #else ! free surface formulation (eta) READ(inum,REC=irec ) sshb(:,:) ; irec = irec +1 READ(inum,REC=irec ) sshn(:,:) ; irec = irec +1 # if defined key_dynspg_ts ! free surface formulation issued from barotropic loop READ(inum,REC=irec ) sshb_b(:,:) ; irec = irec +1 READ(inum,REC=irec ) sshn_b(:,:) ; irec = irec +1 ! horizontal transports issued from barotropic loop READ(inum,REC=irec) un_b(:,:) ; irec = irec +1 READ(inum,REC=irec) vn_b(:,:) ; irec = irec +1 # endif #endif ! TKE arrays #if defined key_zdftke IF ( itke1 == 1 ) THEN DO jk = 1, jpk READ(inum,REC=irec) en(:,:,jk) ; irec = irec +1 END DO ELSE IF(lwp) THEN WRITE(numout,*) ' ===>>>> : the previous restart file didnot used tke scheme' WRITE(numout,*) ' ======= =======' ENDIF nrstdt = 2 ENDIF #endif #if defined key_ice_lim ! Louvain La Neuve Sea Ice Model ! check if it was in the previous run IF ( ios1 == 1 ) THEN READ(inum,REC=irec) zfice(:) ; irec = irec + 1 READ(inum,REC=irec) sst_io(:,:) ; irec = irec + 1 READ(inum,REC=irec) sss_io(:,:) ; irec = irec + 1 READ(inum,REC=irec) u_io (:,:) ; irec = irec + 1 READ(inum,REC=irec) v_io (:,:) ; irec = irec + 1 # if defined key_coupled READ(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1 # endif ENDIF IF ( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' IF(lwp) WRITE(numout,*) sst_io(:,:) = sst_io(:,:) + ( nfice-1 )*( tn(:,:,1) + rt0 ) sss_io(:,:) = sss_io(:,:) + ( nfice-1 )* sn(:,:,1) DO jj = 2, jpj DO ji = 2, jpi u_io(ji,jj) = u_io(ji,jj) + (nfice-1)*0.5*( un(ji-1,jj,1)+un(ji-1,jj-1,1) ) v_io(ji,jj) = v_io(ji,jj) + (nfice-1)*0.5*( vn(ji,jj-1,1)+vn(ji-1,jj-1,1) ) END DO END DO # if defined key_coupled alb_ice(:,:) = 0.8 * tmask(:,:,1) # endif ENDIF #endif #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily ! bulk forcing IF( ios2 == 1 ) THEN READ(inum,REC=irec) zfblk(:) ; irec = irec + 1 READ(inum,REC=irec) gsst (:,:) ; irec = irec + 1 ENDIF IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rst_read : Bulk forcing ==> Initialization ' IF(lwp) WRITE(numout,*) gsst(:,:) = 0.e0 gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 ) ENDIF #endif CLOSE(inum) ! In case of restart with neuler = 0 then put all before fields = to now fields IF ( neuler == 0 ) THEN tb(:,:,:)=tn(:,:,:) sb(:,:,:)=sn(:,:,:) ub(:,:,:)=un(:,:,:) vb(:,:,:)=vn(:,:,:) rotb(:,:,:)=rotn(:,:,:) hdivb(:,:,:)=hdivn(:,:,:) #if defined key_dynspg_rl bsfb(:,:)=bsfn(:,:) ! rigid lid #else sshb(:,:)=sshn(:,:) ! free surface formulation (eta) #endif ENDIF END SUBROUTINE rst_read