Ignore:
Timestamp:
2020-03-13T11:06:44+01:00 (11 months ago)
Author:
orioltp
Message:

Adding precision specification in hardcoded reals and other modifications to allow compilation without forcing reals without precision specification to a certain value through compiler flags

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/IOM/iom.F90

    r12489 r12546  
    13111311               !--- overlap areas and extra hallows (mpp) 
    13121312               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1313                   CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 
     1313                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    13141314               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    13151315                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    13161316                  IF( icnt(3) == inlev ) THEN 
    1317                      CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 
     1317                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    13181318                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    13191319                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
     
    13401340            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    13411341            IF(idom /= jpdom_unknown ) then 
    1342                 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
     1342                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 
    13431343            ENDIF 
    13441344         ELSEIF( PRESENT(pv_r2d) ) THEN 
     
    13471347            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    13481348            IF(idom /= jpdom_unknown ) THEN 
    1349                 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
     1349                CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 
    13501350            ENDIF 
    13511351         ELSEIF( PRESENT(pv_r1d) ) THEN 
     
    13621362!some final adjustments 
    13631363      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 
    1364       IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1. ) 
    1365       IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1. ) 
     1364      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 
     1365      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 
    13661366 
    13671367      !--- Apply scale_factor and offset 
     
    19821982         SELECT CASE ( cdgrd ) 
    19831983         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1984          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. ) 
    1985          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. ) 
     1984         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp ) 
     1985         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp ) 
    19861986         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    19871987         END SELECT 
     
    20262026      ! 
    20272027      z_fld(:,:) = 1._wp 
    2028       CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     2028      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    20292029      ! 
    20302030      ! Cell vertices that can be defined 
     
    20442044      ! Cell vertices on boundries 
    20452045      DO jn = 1, 4 
    2046          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 
    2047          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 
     2046         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 
     2047         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 
    20482048      END DO 
    20492049      ! 
     
    21162116      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    21172117      ! 
    2118 !      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    2119       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     2118!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     2119      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    21202120      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    21212121      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     
    21982198         cl1 = clgrd(jg) 
    21992199         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    2200          CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     2200         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
    22012201         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
    22022202         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
     
    24242424      ! 
    24252425      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    2426          CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
     2426         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 
    24272427         isec = 86400 
    24282428      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.